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1.  INTRODUCTION 


1.1  Purpose  of  the  Report 

This  report  provides  a  copy  of  the  input  files  developed  for  the  modeling  of  turboprop  test 
cells.  These  copies  are  contained  in  the  Appendices  of  this  report  and  are  described  briefly 
below.  A  detailed  discussion  of  building  a  computational  grid  for  this  project  is  provided  in 
the  second  section  of  this  report.  The  results  of  the  turboprop  test  cell  modeling  are 
reported  in  the  first  volume  of  this  report. 

1.2  The  Listings  Provided 

The  listings  are  contained  in  Appendices  B  through  D.  Appendix  B  contains  the  Ql  input 
file,  Appendix  C  contains  the  FORTRAN  SATELLITE  program,  and  Appendix  D  contains 
the  FORTRAN  GROUND  file.  Sketches  are  provided  in  Appendix  A. 


2.  USER  SECTION 


2.1  Grid  Generation 

In  this  section  a  detailed  discussion  for  the  creation  of  a  computational  grid  is  supplied. 
The  bulk  of  the  input  for  this  model  deals  with  producing  a  computational  grid.  The  code 
was  designed  for  relatively  easy  modifications  with  the  flexibility  to  model  a  range  of 
changes  as  called  for  in  the  scope  of  work. 

The  premise  of  this  procedure  is  that  a  2-dimensional  package  will  be  used  to  create 
various  cross  sectional  planes.  These  planes  will  then  be  stacked,  blended  or  rotated  to 
create  the  final  3— dimensional  computational  grid.  In  general,  the  program  works  as 
follows:  1.)  the  user  specifies  all  the  inputs  necessary  for  the  creation  of  all  the  various 
2— dimensional  cross  sectional  (X— Y)  planes  inside  the  standard  input  files  (Ql  and 
SATLIT),  2.)  the  standard  input  files  are  then  executed  to  produce  the  data  files  needed 
for  the  2-dimensional  grid  generation  program  (EasyMesh2D  or  GGP),  3.)  GGP  is  then 
executed  for  each  data  plane  produced,  and  4.)  the  standard  input  files  are  re— executed  to 
produce  the  final  grid  and  the  other  input  files  needed  for  the  solver. 

The  standard  input  files  will  create  5  types  of  X— Y  planes.  Each  plane  can  have  several 
different  varieties  or  subsets.  The  first  type  (TYPE  1)  of  plane  is  used  to  describe  the  test 
bed  up  to  the  engine.  The  planes  are  broken  down  into  various  regions  in  the  X  and  Y 
directions.  The  user  must  specify  the  total  distance  from  the  origin  for  each  region,  the 
number  of  cells  in  each  region,  and  the  clustering  factor  for  the  griding  of  each  region. 

Each  of  these  will  be  detailed  later  in  this  section. 

The  second  type  (TYPE  2)  is  used  to  describe  the  X— Y  cross  section  of  the  engine  exit  and 
the  augmenter  lip.  TYPE  3  is  used  for  X-Y  cross  section  that  across  the  augmenter  tube. 
The  fourth  type  (TYPE  4)  is  used  to  describe  the  triangular  room  in  front  of  the  chimney 
and  the  front  face  of  the  chimney.  The  final  type  (TYPE  5)  is  used  to  describe  the  exit 
plane.  Additional  information  may  be  supplied  in  the  input  files. 


The  file  name  nomenclature  for  the  data  files  for  the  GGP  is  that  the  file  name  starts  with 
the  letter  CS.  Then  numbers  are  added  as  suffixes  starting  at  61  and  continuing  until  all 
planes  are  created.  The  data  files  are  created  in  order.  For  TYPE  1  there  are  five  different 
subsets  (CS  files)  created.  The  first  (CS61)  is  used  to  describe  the  inlet  plane,  the  second 
(CS62)  produces  a  cross  section  of  the  front  of  the  orifice  while  the  third  (CS63)  produces 
the  back  of  the  orifice,  the  fourth  (CS64)  represents  a  X-Y  section  across  the  reduction 
gear,  and  the  last  (CS65)  is  used  to  describe  the  engine  inlet. 

CS61  is  a  mostly  orthogonal  grid  used  to  represent  the  inlet  plane.  Various  lines  will  be 
converted  to  arcs  in  order  to  represent  the  orifice,  prop,  reduction  gear,  and  engine  inlet. 
CS62  has  an  outer  circle  which  represents  the  orifice.  It  also  contains  two  other  circles, 
which  do  not  physically  represent  an  object  at  this  plane  but  will  be  used  in  other  cross 
sections  to  represent  the  prop  (middle  circle)  or  the  reduction  gear  or  engine  inlet  (inside 
circle).  This  procedure  helps  to  maximize  the  orthogonality  for  the  total  grid.  CS63  is 
identical  to  CS62  with  the  exception  that  the  diameter  of  the  orifice  has  been  reduced. 

CS64  is  a  repeat  of  CS62  thus  allowing  the  spacing  between  the  outer  and  middle  circle  to 
be  expanded.  The  final  cross  section  (CS65)  is  identical  to  CS64  except  that  in  inner  circle 
it  now  represents  the  engine  inlet. 

For  TYPE  1  files  there  are  7  regions  that  are  defined  in  the  X-direction  and  8  regions  are 
used  in  the  definition  for  the  griding  in  the  Y— direction.  For  each  region  the  following 
information  is  needed 

The  number  of  cells  of  each  region. 

The  distance  to  the  end  of  the  region,  and 

A  grid  clustering  factor. 

The  nomenclature  for  each  of  these  variables  is  given  in  the  Q1  file.  They  are  noted  in 
Figure  1  of  this  report.  In  this  figure  the  regions  in  both  directions  for  CS61  are  noted 
along  with  distance  and  clustering  nomenclature.  This  input  is  used  primarily  for  the 
description  of  lines  and  arcs  in  the  data  files  for  GGP.  Figure  2  is  the  copy  of  a  graphical 
display  produced  during  the  creation  of  the  2— D  grid  file.  In  this  figure  the  full  grid  is 
displayed.  Similarly  plots  for  CS62  are  supplied.  In  general,  the  data  suppbed  for  CS61 
are  used  for  CS62  through  CS65.  The  dimensions  of  the  various  circles  are  used  to 
calculate  the  corresponding  squares  in  CS61.  This  is  why  some  of  the  variables  used  to 
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represent  distance  are  set  to  0.000000.  A  integer  array  is  used  as  a  marker  to  note  the  first 
region  that  contains  an  arc.  The  variable  XGAP  is  the  x— direction  length  of  the  gap  over 
the  orifice  while  IGAP  is  the  number  of  cells  in  this  gap. 

Note  in  Figure  4  that  it  appears  that  lines  overlap  in  the  circular  region.  This  is  because 
some  lines  are  overwritten  with  arc  data.  If  this  persists  after  a  redraw  in  the  GGP,  major 
problems  with  the  grid  exist.  More  details  in  regard  to  the  execution  of  GGP  will  be  given 
later  in  this  section. 

When  the  initial  grid  is  completed,  the  orthogonality  of  corner  points  of  the  circle  can  be 
improved  (note  Figure  5  and  6).  This  is  done  in  the  smoothing  operations  of  the  GGP. 

The  number  of  cells  affected  by  this  is  controlled  by  the  variable  ISOL  located  in  the 
SATLIT  file.  In  general  these  values  will  not  need  to  be  adjusted.  Also  plots  of  final  grid 
CS63  and  initial  grid  CS65  are  shown  in  Figures  7  and  8. 

The  coding  was  designed  so  that  major  changes  would  be  fairly  straight  forward.  The 
input  files  has  slots  for  14  regions  in  each  direction  so  that  if  more  regions  are  needed  in  the 
future  the  accommodations  can  be  made.  Also,  the  number  of  cells  for  each  region  in  the 
remaining  types  are  not  required  but  are  pbtained  from  the  number  of  cells  supplied  for 
each  region  in  TYPE  1. 

TYPE  2  data  produces  two  or  three  CS  files.  The  first  is  for  the  exit  of  the  engine  which  is 
also  the  same  as  for  the  inlet  of  the  augmenter  tube.  The  second  is  for  the  end  of  the 
augmenter  lip.  A  third  cross  section  may  be  required  if  the  exit  of  the  engine  falls  within 
the  lip  or  within  the  sleeve.  See  Appendix  A  for  more  details.  The  only  difference  in  these 
CS  files  will  be  the  diameter  of  the  two  circles.  Since  the  diameter  of  augmenter  tube  is 
larger  than  the  engine  exit  additional  cells  are  needed.  The  number  of  cells  is  controlled  by 
variables  NXAD  and  NYAD.  For  the  case  delivered  two  CS  files  (CS66  and  CS67)  were 
produced.  The  regions  and  initial  grids  for  TYPE  2  are  shown  in  Figure  9  through  11. 

TYPE  3  data  will  produce  three  CS  files.  The  first  file  is  for  the  augmenter  sleeve,  the 
second  is  for  the  large  diameter  augmenter  tube,  and  the  last  is  for  the  small  diameter 
augmenter  tube.  The  difference  in  these  files  are  due  to  the  different  diameters.  The 
regions  and  grids  (CS68,  CS69,  and  CS70)  are  shown  in  Figure  12  through  16. 
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TYPE  4  data  produces  two  CS  files  (CS71  and  CS72).  There  is  a  small  triangular  room  in 
front  of  the  chimney.  Constructing  a  grid  from  the  whole  room  is  impossible  (grid  lines 
would  be  on  top  of  each  other).  The  front  half  was  removed.  The  rest  was  then  included 
in  the  model.  However  due  to  orthogonality  problems  (see  Figures  21  and  22)  this  room 
was  blocked  off  and  the  ceiling  was  lowered.  The  first  cross  section  represents  the 
truncated  front  of  the  traingular  room  while  the  second  represents  the  front  face  of  the 
chimney.  This  is  the  first  cross  sections  in  which  the  first  region  does  not  start  at  a  0.0 
X— coordinate  value.  A  integer  array  element  noted  in  the  Ql  files  takes  this  into  account. 
A  plot  of  regions  and  grids  are  shown  in  Figures  17  through  19. 

The  last  grid  is  denoted  by  TYPE  5.  It  is  located  at  the  exit  of  the  chimney.  The  input 
needed  to  produce  this  data  file  is  taken  from  previously  suppfied  information.  The  grid  for 
CS73  is  shown  in  Figure  20. 

There  is  a  integer  array  element  that  represents  the  stage  of  grid  development.  It  is 
located  in  Group  6  of  the  Ql  file  as  is  called  IG  (1).  If  the  value  of  this  element  is  set  to  0, 
when  the  input  files  are  executed,  they  will  produce  a  set  of  data  files  for  the  GGP.  If  it  is 
set  to  1,  then  it  will  read  the  grid  files  produced  by  the  GGP  and  create  a  3-dimensional 
grid  along  with  the  other  input  files  for  the  solver.  If  the  grid  is  already  created  the  value 
is  set  to  2  in  order  to  bypass  the  grid  creation  coding. 

In  the  form  delivered,  13  data  files  for  the  GGP  will  be  created  during  the  first  execution  of 
the  input  files.  At  this  time  the  user  will  then  execute  GGP  as  indicated  in  the 
documentation  (probably  done  by  entering  runezm).  The  first  item  needed  will  be  terminal 
type.  Enter  the  appropriate  value.  Following  this  prompt,  menus  will  appear  on  the 
screen.  The  following  series  of  commands  will  go  through  these  menus  and  produce  a  grid 
file. 


PROMPT 

ENTER 

COMMENT 

Model  name 

CS61 

Use  same  name  as  file  to  be  read  in 

EZ2  > 

RE  CS61 

Reads  in  input  file 

EZ2  > 

WR 

Goes  to  menu  to  write  grid 

WRITE  > 

END 

Writes  grid 

EZ2  > 

END 

End  session 

This  is  done  when  the  grid  to  be  produced  is  totally  orthogonal  (i.e.  no  circles).  After  the 


input  file  is  read  a  redraw  of  the  screen  can  be  done  through  the  REDR  command.  If  lines 
cross  after  this  point  there  is  an  error  in  the  input  file  for  the  GGP.  Looking  at  the  grid 
may  give  clues  as  to  the  cause  of  the  problem.  If  a  grid  needs  to  be  smoothed  (all  files  that 
contains  a  circle),  the  following  commands  will  be  needed. 


PROMPT 

ENTER 

COMMENT 

Model  Name: 

CS62 

Use  same  name  as  file  to  be  read  in 

EZ2  > 

RE  CS62 

Reads  in  input  file 

EZ2  > 

SM 

Goes  to  smoothing  menu 

SMOOTH  > 

SO 

Solves  differential  equations 

SMOOTH  > 

REDR 

Plots  final  grid 

SMOOTH  > 

END 

Returns  to  main  menu 

EZ2  > 

WR 

Goes  to  menu  to  write  grid 

WRITE  > 

END 

Writes  grid 

EZ2  > 

END 

End  session 

After  the  creation  of  these  2-<iimensional  grid  files,  input  in  Q1  file  is  required  for  the 
formation  of  the  final  3-dimensional  grid.  As  in  the  specification  of  the  grid  in  the  X  and 
Y— directions,  the  user  must  supply  the  number  of  regions,  the  distance  to  the  end  of  the 
region,  the  number  of  cells,  and  the  grid  clustering  factor.  Allocations  for  25  regions  in  the 
axial  direction  have  been  provided.  As  delivered,  20  have  been  specified. 

The  user  must  then  supply  the  information  for  the  building  of  the  final  grid.  Four  options 
are  available  1.)  Stack,  2.)  Blend,  3.)  Rotate,  and  4.)  End.  Throughout  the  test  cell  the 
first  two  options  are  used  to  stack  and  blend  the  2— dimensional  grid  files  as  needed,  while 
the  last  two  options  create  the  grid  in  the  chimney  region.  This  information  is  passed  to 
the  SATLIT  from  the  Q1  through  an  integer  array. 

2.2  Other  Input 

In  group  9  of  the  input  files  most  of  the  data  for  the  physics  of  the  model  is  supplied. 

These  deal  with  flow  rates,  temperatures,  mass  fractions,  etc.  These  are  documented  in  the 
input  files. 
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2.3  Relaxation 


Relaxation  is  a  numerical  technique  that  allows  the  rate  of  change  of  various  solved 
variables  to  be  controlled.  It  is  generally  used  to  dampen  the  amount  of  change  computed 
by  the  various  computer  codes.  There  are  many  views  on  the  optimum  settings  of  the 
relaxation  parameters.  In  a  problem  of  this  size  time  constraints  reduce  the  amount  of 
effort  in  optimization  of  these  parameters.  The  approach  used  was  to  reduce  the  relaxation 
(base  values  calculated  on  a  cell  residence  time)  at  the  start  of  a  computational  run  and 
then  apply  tighter  relaxation  after  a  few  hundred  solution  sweeps  through  the  calculation 
domain. 

The  values  of  the  relaxation  parameters  is  given  in  the  following  table. 

Table  1.  Relaxation  Parameters 


Variable 

Type 

Initial  Value 

Final  Value 

PI 

LINRLX 

0.15 

0.05 

U1 

FALSDT 

0.001 

0.0003 

VI 

FALSDT 

0.001 

0.0003 

Wl 

FALSDT 

0.001 

0.0003 

KE 

LINRLX 

0.10 

0.10 

EP 

LINRLX 

0.10 

0.10 

HI 

FALSDT 

0.005 

0.001 

Cl 

FALSDT 

0.005 

0.001 

Note  the  two  types  of  relaxations  are  discussed  in  the  users  guide.  The  final  values  were 
used  after  sweep  2758.  (See  following  section  for  procedure  to  change  relaxation.)  It  was 
observed  during  the  reported  run  that  monitor  values  downstream  of  the  propeller  tip  were 
oscillating  from  sweep  to  sweep  (i.e.,  for  Wl  values  changed  from  10  m/s  to  —5  m/s).  This 
was  stopped  by  clamping  down  on  the  pressure  relaxation  to  0.025  at  sweep  948  and  letting 
back  up  to  a  value  of  0.125  at  sweep  1103.  During  the  first  900  sweeps  of  this 
computational  run,  the  sources  for  the  propeller  had  not  been  properly  implimented.  When 
the  completed  model  was  started  from  scratch  it  was  noted  that  the  pressure  relaxation 
had  to  be  lowered  to  a  value  of  0.10. 


Depending  on  computer  systems,  it  may  take  a  few  weeks  to  obtain  a  fully  converged 
solution.  The  code  allows  for  restarts  using  previous  data.  For  some  cases  this  may  not  be 
the  best  procedure  as  compared  to  one  long  run.  Because  of  this  various  controls  were  put 
in  the  GROUND  coding  that  allows  the  user  to  vary  items  during  one  long  rim.  This 
coding  allows  the  user  to: 

1.  Abort  a  run  with  standard  output  produced, 

2.  Modify  pressure  relaxation, 

3.  Modify  turbulence  relaxation, 

4.  Modify  velocity  relaxation, 

5.  Modify  scalar  relaxation, 

6.  Dump  a  restart  file  on  demand, 

7.  Change  frequency  of  monitor  printout, 

8.  Change  frequency  of  residual  printout, 

9.  Change  the  number  of  variables  in  the  monitoring  values  printed,  and 

10.  Change  two  monitor  locations. 

This  is  accomplished  by: 

1.  Providing  a  file  called  ABORT, 

2.  Providing  a  value  in  the  F12.8  Format  in  a  file  called  RELAXP, 

3.  Providing  two  values  in  the  2F12.8  Format  in  a  file  called  RELAXT, 

4.  Providing  three  values  in  the  3F12.8  Format  in  a  file  called  RELAXV, 

5.  Providing  two  values  in  the  2F12.8  Format  in  a  file  called  RELAXS, 

6.  Providing  a  file  called  DUMPIT, 

7.  Providing  a  value  in  the  15  Format  in  a  file  called  TSTMOD, 

8.  Providing  a  value  in  the  15  Format  in  a  file  called  NPRMOD, 

9.  Providing  four  values  in  the  412  Format  in  a  file  called  IGGMOD  (value  of  1 
activates  printout  while  a  value  of  0  deactivates),  and 

10.  Provide  three  values  in  the  313  Format  in  a  file  called  ML2MOD  or  ML3MOD 
(values  are  for  the  IX,  lY,  and  IZ  locations). 


2.5  Additional  Printout 


In  addition  to  the  standard  output  the  following  printout  is  provided: 

1.  Ten  monitoring  locations, 

2.  The  maximum  and  minimum  values  for  certain  variables, 

3.  Convergence  information, 

4.  Pumping  ratios,  and 

5.  Heat  transfer  information. 

Note  the  previous  section  provided  some  information  about  control  of  the  monitoring 
printout.  The  max— min  printout  may  give  clues  to  problem  areais.  Monitoring  printout 
can  then  be  shifted  to  these  locations.  The  convergence  information  gives  a  mass  and 
momentum  error  based  on  mass  and  momentum  sources.  A  value  of  under  1%  for  mass 
and  3%  for  momentum  should  be  acceptable.  In  addition,  the  pumping  ratio  for  the  engine 
is  printed.  When  these  value  become  asymptotic,  this  may  indicate  convergence.  Printout 
is  also  provided  for  the  heat  transfer  through  the  augmenter  tube  in  the  building  and  in  the 
chimney.  Similarly  asymptotic  values  point  toward  convergence. 
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'ALK=F;RUN(1,1) 

GROUP  1.  Run  title  and  other  preliminaries 
"’EXT(NCEL:  TEST  CELL— TURBOPROP  ENGINE) 


★*★****★*  GRID  SECTION  ★**★***★***★ 

*******************<f***^^lf********1t**Hr***************************^t*** 


*** 

★  ** 
*** 
*** 
★  ** 

*★* 

*** 

*** 


PRELIMINARY:  Grid  generation  is  an  art  form.  This 

model  attempts  to  make  this  process  as  painless  as 
possible.  Several  assumptions  will  be  made  during 
this  procedure.  Each  will  be  stated  at  an  appropriate 
time.  These  assumptions  will  limit  the  parametric 
geometrical  studies  that  can  be  accomplished . 

Geometric  changes  as  called  for  by  the  contract  will 
be  possible  and  fairly  easy  to  implement.  This  method 
will  not  make  it  easy  for  radical  modifications  to  be 
modeled.  However,  with  the  appropriate  assistance  such 
changes  should  be  possible. 
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PREMISE:  The  grid  for  the  test  cell  is  created  from  a 

2- dimensional  grid  generation  package.  This  package 
produces  several  X-Y  cross  sections.  These  sections 
are  then  stacked,  blended,  or  rotated  to  produce  the 
entire  computational  domain.  In  order  to  do  this,'  grid 
information  data  is  supplied  by  the  user  in  the  Q1 
file.  This  information  'is  then  transferred  to  SATLIT 
where  the  input  files  for  the  grid  generation  are 
created.  The  user  must  then  manually  run  the  grid 
generation  program  to  produce. a  plane  of  X-Y  grid 
points  for  each  input  file.  After  this  the  user  will 
then  rerun  the  preprocessor  (Ql-SATLIT)  at  which  time 
the  full  computational  grid  will  be  produced.  This  is 
controlled  by  the  setting  of  IG(1)  in  GROUP  6.  If  IG(1) 
is  set  to  0  the  execution  of  Ql-SATLIT  produces  the 
input  files  for  the  grid  generation  package;  if  set  to  1 
execution  of  Ql-SATLIT  reads  2-D  grid  data  and  creates 

3- D  grid  file;  if  set  to  2  grid  generation  is  by-passed 
and  existing  3-D  grid  file  is  used.  Also,  if  IG(1)  is 
set  to  3  (GROUP  9)  boundary  conditions  are  calculated  in 
SATLIT.  This  current  method  is  not  fully  automated, 

but  it  requires  the  user  to  examine  each  computational 
plane,  which  can  reduce  grid  errors. 
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DESCRIPTION  OF  PLANES:  In  its  present  form  the  SATLIT 
will  write  out  5  types  of  X-Y  planes.  Out  of  these 
various  types  of  planes,  modifications  (or  subtypes) 
are  created  (ie.  the  augmenter  tuoe  diameter  changes). 
For  the  case  that  is  delivered,  13  planes  of  grids 
are  created.  A  description  of  each  plane  is  now 
provided . 


Indicated  oy  lezzer  A. 
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TY^E  1 


ype  IS  used 
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*** 
*  *  * 
*** 
*** 
*** 
*** 
*** 
★  *  * 
*** 
*** 
*** 
*** 
*** 
*** 
*** 


for  the  orifice.  There  are  five  planes  created  under 
this  type.  The  first  is  located  at  the  entrance.  In 
this  plane  the  circles  of  the  orifice  and  the  reduction 
gear/engine  have  been  mapped  into  a  square.  The  second 
is  a  cross  section  at  the  front  of  the  orifice.  The 
third  is  a  plane  at  the  constant  cross  section  of  the 
orifice.  The  fourth  is  at  the  start  of  the  reduction 
gear  while  the  fifth  is  located  at  the  start  of  the 
engine.  The  last  four  planes  contain  an  inner  circle 
which  corresponds  to  the  diameter  of  reduction  gear/ 
engine  and  a  mid  circle  which  represents  the  prop. 
ASSUMPTION:  It  is  assumed  that  the  diameter  of  the 

prop  is  less  than  both  orifice  openings.  Also,  the 
outer  diameter  has  been  increase  at  the  fourth  plane. 
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*** 

*** 

*** 

*** 

*** 


TYPE  2  —  Indicated  by  letter  B.  This  type  is  used  at 

the  engine  exit  and  the  lip  region.  This  type  produces 
two  or  three  planes  of  data.  Normally  it  will  produce 
one  for  the  augmenter  lip  and  one  for  the  augmenter 
sleeve.  If  the  engine  falls  in  the  tappered  lip 
section  an  additional  plane  corresponding  to  this 
location  will  be  needed  and  will  become  the  second  of 
the  three  planes  produced . 


*** 

*** 

*** 
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*** 

*** 

*** 


TYPE  3  —  Indicated  by  letter  C.  This  type  is  used  to 

create  the  augmenter  tube  in  the  building.  There  are 
three  planes  produced  under  this  type.  The  first  is 
located  at  the  end  of  the  augmenter  sleeve,  the  second 
is  a  cross  section  of  the  large  diameter  portion  of  the 
tube,  while  the  third  is  a  slice  of  the  small  diameter 
section  of  the  augmenter  tube. 
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*** 

*** 
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*** 


TYPE  4  —  Indicated  by  letter  D.  This  type  is  used 

to  create  the  augmenter  tube  in  the  chimney  section. 

Two  planes  are  created  for  this  type.  The  first  is  for 
the  start  of  the  triangler  section  while  the  last  is 
located  at  the  end  of  triangler  section.  ASSUMPTION: 
the  point  section  is  sliced  off  at  given  distance  in 
order  to  make  the  walls  fall  outside  the  diameter  of 
the  augmenter  tube. 
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TYPE  5  —  Data  needed  for  this  plane  is  taken  from  the 

other  types.  This  type  creates  the  exit  plane  (top  of 
chimney ) . 


*** 

*** 

*** 

*** 


At  this  time  each  variable  used  in  the  description  of 
griding  in  the  X-direction  (horizontal)  will  be  provided. 
The  (0,0,0)  coordinate  is  located  (standing  in  front  of 
building)  at  the  lower  right  hand  corner.  Parameters 
are  used  extensively  throughout  this  program  to  make 
changes  easier. 


*** 
*** 
*** 
*** 
*** 
**  * 
*  *  * 


************************************  ll^*  ********************★★★*★**★★  * 

*********  X-DIRECTION  GRIDING  ************ 


NRXA 


Number  of  X  regions  for  Type  1  plane 


* 

*  *  * 


*** 

NRXB 

•- 

Number  of  X  regions  for  Type  2  plane 

kkk 

*** 

NRXC 

•  - 

Number  of  X  regions  for  Type  3  plane 

kkk 

■kick 

NRXD 

•  - 

Number  of  X  regions  for  Type  4  plane 

kkk 

kkk 

kkk 

k** 

NOTE :  The 

number  of  grid  cells  is  define  for  the  Type  1 

*** 

*** 

plane  and  then  redistributed  for  the  other  types. 

kkk 

*** 

There  are  fourteen  available  regions,  some  may  not 

kkk 

kkk 

be  used . 

kkk 

kkk 

kkk 

kkk 

NXOl 

Number  of  cells  in  1st  region  ->  Wall  to 

kkk 

kkk 

gap 

kkk 

kkk 

NX02 

•- 

Number  of  cells  in  2nd  region  ->  Gap  to 

kkk 

*** 

orifice 

kkk 

*** 

NX03 

•  - 

Number  of  cells  in  3rd  region  ->  Orifice  to 

kkk 

kkk 

prop  tip 

kkk 

*** 

NX04 

•- 

Number  of  cells  in  4th  region  ->  Prop  tip  to 

kkk 

*** 

center  of  prop 

kkk 

kkk 

NX05 

■- 

Number  of  cells  in  7th  region  ->  Center  of 

kkk 

*** 

prop  to  prop  tip 

kkk 

*** 

NX06 

•- 

Number  of  cells  in  8th  region  ->  Prop  tip  to 

kkk 

*** 

orifice 

kkk 

kkk 

NX07 

•  - 

Number  of  cells  in  9th  region  ->  Orifice  to 

kkk 

*** 

wall 

kkk 

kkk 

NX08 

■  - 

Number  of  cells  in  10th  region  ->  Spare 

kkk 

*** 

NX09 

■  - 

Number  of  cells  in  10th  region  ->  Spare 

kkk 

kkk 

NXIO 

•- 

Number  of  cells  in  10th  region  ->  Spare 

kkk 

kkk 

NXll 

■- 

Number  of  cells  in  11th  region  ->  Spare 

kkk 

kkk 

NX12 

■  - 

Number  of  cells  in  12th  region  ->  Spare 

kkk 

kkk 

NX13 

Number  of  cells  in  13th  region  ->  Spare 

kkk 

kkk 

NX14 

■  - 

Number  of  cells  in  14th  region  ->  Spare 

kkk 

kkk 

kkk 

kkk 

NOTE :  The 

regions  for  the  other  4  Types  will  now  also 

kkk 

*** 

be  defined. 

*** 

kkk 

TYPE  2 

*** 

kkk 

Region 

1 

—  Wall  to  half  distance  augmenter  tube 

*** 

kkk 

Region 

2 

—  Half  distance  augmenter  tube  to  aug  tube 

*** 

kkk 

Region 

3 

Augmenter  tube  to  engine 

*** 

kkk 

Region 

4 

Engine  to  midpoint'  engine 

*** 

kkk 

Region 

5 

—  Midpoint  engine  to  engine 

*** 

*** 

Region 

6 

—  Engine  to  augmenter  tube 

*** 

*** 

Region 

7 

Augmenter  tube  to  half  distance  aug  tube 

kkk 

kkk 

Region 

8 

—  Half  distance  augmenter  tube  to  wall 

kkk 

*** 

TYPE  3 

kkk 

kkk 

Region 

1 

—  Wall  to  half  distance  augmenter  tube 

kkk 

*** 

Region 

2 

Half  distance  augmenter  tube  to  aug  tube 

kkk 

*** 

Region 

3 

—  Augmenter  tube  to  midpoint  aug  tube 

*** 

*** 

Region 

4 

—  Midpoint  augmenter  tube  to  aug  tube 

*** 

kkk 

Region 

5 

—  Augmenter  tube  to  half  distance  aug  tube 

kkk 

*** 

Region 

6 

Half  distance  augmenter  tube  to  wall 

kkk 

*** 

TYPE  4 

kkk 

kkk 

Region 

1 

—  Wall  to  augmenter  tube 

kkk 

*r** 

Region 

2 

Augmenter  tube  to  midpoint  aug  tube 

kkk 

kkk 

Region 

3 

Midpoint  augmenter  tube  to  aug  tube 

kkk 

kkk 

Region 

4 

Augmenter  tube  to  wall 

kkk 

kkk 

TYPE  5 

kkk 

kkk 

A  4r  4r 

Region 

1 

—  Wall  to  wall 

kkk 

kkk 

★  ★  * 

NXAD 

One-half  number  of  cells  in  X-direction  used 

kkk 

★  *  * 

for  the  reduction  gear/engine 

kkk 

icic-k 

NXBD 

- 

Number  of  cells  in  X-direction  used  for 

kkk 

NXBD 


X 


*** 

rearrangement  of  three  regions  into  two 

*** 

*** 

NOTE: 

This 

last  two  items  have  corresponding  parameters 

*** 

*** 

for 

the  Y-direction.  Generally  they  will  be  the 

*** 

*it* 

the 

same 

*** 

*** 

*** 

is** 

IXAF** 

— 

First  cell  number  of  **  region  Type  1 

*** 

*** 

IXAL** 

— 

Last  cell  number  of  **  region  Type  1 

*** 

*** 

IXBF** 

— 

First  cell  number  of  **  region  Type  2 

*** 

*** 

IXBL** 

— 

Last  cell  number  of  **  region  Type  2 

*** 

*** 

IXCF** 

— 

First  cell  number  of  **  region  Type  3 

*** 

*** 

IXCL** 

— 

Last  cell  number  of  **  region  Type  3 

*** 

*** 

IXDF** 

— 

First  cell  number  of  **  region  Type  4 

*** 

*** 

IXDL** 

— 

Last  cell  number  of  **  region  Type  4 

*** 

*** 

*** 

IXMON* 

— 

Location  of  *  monitoring  point  (9  extra) 

*** 

*** 

*** 

*** 

XLA** 

— 

Length  to  end  of  **  region  Type  l  (in) 

*** 

*** 

XLB** 

— 

Length  to  end  of  **  region  Type  2  ( in ) 

*** 

*** 

XLC** 

— 

Length  to  end  of  **  region  Type  3  (in) 

*** 

*** 

XLD** 

— 

Length  to  end  of  **  region  Type  4  (in) 

*** 

*** 

*** 

*** 

PXA** 

— 

Clustering  factor  of  **  region  Type  1 

*** 

*** 

PXB** 

— 

Clustering  factor  of  **  region  Type  2 

*** 

*** 

PXC** 

— 

Clustering  factor  of  **  region  Type  3 

*** 

*** 

PXD** 

— 

Clustering  factor  of  **  region  Type  4 

*** 

*** 

NOTE: 

Clustering  factor  is  a  number  used  to  shift  the 

*** 

*** 

cell 

spacing  in  one  direction.  This  direction  is 

*** 

*** 

controlled  by  setting  this  value  to  either  a 

*** 

*** 

positive  or  negative  value.  The  default  (uniform 

*** 

*** 

spacing)  is  l.O.  This  value  may  be  less  than  or 

*** 

*** 

greater  than  l.O. 

*** 

*** 

*** 

*** 

NOTE: 

Some 

Y-info  defined  here 

*** 

*** 

XCENA 

-- 

Location  in  the  X-direction  of  the  center  of 

*** 

*** 

the  orifice  (in) 

*** 

*** 

YCENA 

— 

Location  in  the  Y-direction  of  the  center  of 

*** 

*** 

the  orifice  (in) 

*** 

*** 

XCENB 

-- 

Location  in  the  X-direction  of  the  center  of 

*** 

*** 

the  prop  and  reduction  gear  (in) 

*** 

*** 

YCENB 

— 

Location  in  the  Y-direction  of  the  center  of 

*** 

*** 

the  prop  and  reduction  gear  (in) 

*** 

*** 

XCENC 

— 

Location  in  the  X-direction  of  the  center  of 

*** 

*** 

the  engine  (in) 

*** 

*** 

YCENC 

— 

Location  in  the  Y-direction  of  the  center  of 

*** 

*** 

the  engine  (in) 

Hr** 

*** 

XCEND 

— 

Location  in  the  X-direction  of  the  center  of 

*** 

*** 

the  augmenter  tube  (in) 

*** 

*** 

YCEND 

— 

Location  in  the  Y-dlrection  of  the  center  of 

*** 

*** 

the  augmenter  tube  (in) 

*** 

*** 

*** 

*  *  * 

DORFF 

-- 

Diameter  of  orifice  front  (in) 

*** 

*** 

DORFB 

-- 

Diameter  of  orifice  back  (in) 

*** 

*** 

DPROP 

— 

Diameter  of  prop  (in) 

*** 

■KX* 

DGEAR 

-- 

Diameter  of  reduction  gear  (in) 

*** 

*** 

DENGI 

— 

Diameter  of  engine  (in) 

*** 

*** 

DAUGL 

— 

Diameter  of  augmenter  tube  lip  (in) 

*** 

*** 

DAUGS 

— 

Diameter  of  augmenter  sleeve  (in) 

*** 

*** 

DAGTF 

-- 

Diameter  of  aug  tube  before  reduction  (in) 

*** 

XXX 

DAGTB 

-- 

Diameter  of  aug  tube  after  reduction  (in) 

*** 

ir'fC'K 


NOTE: 


DAUGM 


XGAP 


IGAP 


The  following  Input  is  for  the  engine  exit  falling 
in  the  augmenter  lip  region.  The  number  of  planes 
produced  is  controlled  by  the  setting  of  IG(60). 
For  this  situation  it  will  be  set  to  3  other  wise 
it  will  be  2. 

IG,  RG,  &  LG  are  built  in  arrays  that  allow  for 
easy  transfer  of  integers,  reals,  and  logicals  to 
the  various  modules  of  the  code. 

—  Diameter  of  augmenter  tube  lip  midpoint  (in) 

Length  in  X-direction  of  the  upper  gap  (in) 

—  Number  of  cells  in  upper  gap 


******************************************************************** 


******************************************************************* 
***  *** 

***  LOGICALS:  There  is  1  logical  flag  in  the  Q1  file.  It  *** 

***  is  outlined  below.  *** 

***  *** 

***  LG(l)  —  T  if  the  engine  exit  falls  in  aug  lip  region  *** 

***  *** 

***  WARNING:  Certain  lines  of  coding  have  to  be  activated  *** 

***  or  deactivated  for  certain  logicals.  Search  *** 

***  for  the  string  S1&61LGS1&&  to  locate  such  coding.  *** 

***  Active  coding  starts  in  the  first  two  columns.  *** 

***  NOTE:  There  is  certain  coding  that  is  needed  for  *** 

***  specific  grid  types.  It  will  be  ignored  if  not  *** 

***  needed.  Generally  this  type  of  data  is  indented  *** 

***  by  one  space.  *** 

***  *** 

******************************************************************* 


******************************************************************* 


***  OTHER  STUFF:  Additional  information  is  needed  in  the  *** 
***  SATLIT  to  create  the  grid  input  files  for  the  grid  *** 
***  generation  pac)cage.  For  each  type  of  plane  in  both  *** 
***  the  X  &  Y  directions  the  user  must  specify  what  region  *** 
***  the  'circle'  starts  on.  For  instance  in  the  *** 
***  X-direction  for  the  Type  1  it  is  the  third  region,  *** 
***  therefore  it  is  passed  into  SATLIT  in  the  17  slot  *** 
***  (ie  IG(117))  of  the  last  cell  number.  It  is  assumed  *** 
***  that  the  first  X-Coordinate  is  0.0.  This  is  the  case  *** 
***  in  all  planes  except  the  two  created  for  the  chimney.  *** 
***  For  these  cases  the  first  X-distance  is  passed  to  *** 
***  SATLIT  through  the  RG  array  elements  that  are  10  above  *** 
***  the  logical  unit  used  to  write  out  the  grid  data  file.  *** 
***  For  this  case  it  is  the  11th  (LU=7l)  and  12th  (LU=72)  *** 
***  planes  and  RG(81)  and  RG(82)  are  set  to  the  *** 
***  appropriate  values.  *** 


*XXXXXXXXXXXXXXXXXXXXX  DECLARE  X  XXXXXXXXXXXXXXXXXXXXXXXXXXXXX* 
* 

* 

INTEGER ( NRXA , NRXB , NRXC , NRXD ) 

INTEGER  (NXOl  ,NX02  ,NX03  ,NX04  ,NX05  ,NX06  ,NX07  ,NX08  ,NX09  ,NX10  ) 

INTEGER ( NXl 1 , NXl 2 , NXl 3 , NXl 4 ) 

INTEGER { NXAD , NXBD ) 

INTEGER ( IXAFOl , IXAF02 , IXAFO  3 , IXAF04 , IXAF05 ) 

INTEGER ( IXAF06 , IXAP07 , IXAP08 , IXAF09 , IXAFIO ) 

INTEGER ( IXAFll , IXAF12 , IXAFl 3 , IXAF14 , IXAPIS ) 

INTEGER ( IXALOl , IXAL02 , IXALO  3 , IXAL04 , IXAL05 ) 

INTEGER ( IXAL06 , IXAL07 , IXAL08 , IXAL09 , IXALIO ) 

INTEGER ( IXALll , IXAL12 , IXALl 3 , IXAL14 , IXAL15 ) 

INTEGER ( IXBFOl , IXBF02 , IXBF03 , IXBF04 , IXBP05 ) 

INTEGER ( IXBF06 , IXBF07 , IXBF08 , IXBF09 , IXBPIO ) 

INTEGER ( IXBPll , IXBF12 , IXBFl 3 , IXBF14 , IXBP15 ) 

INTEGER ( IXBLOl , IXBL02 , IXBL03 , IXBL04 , IXBL05 ) 

INTEGER ( IXBL06 , IXBL07 , IXBL08 , IXBL09 , IXBLIO ) 

INTEGER ( IXBLll , IXBL12 , IXBLl 3 , IXBL14 , IXBL15 ) 

INTEGER ( IXCFOl , IXCF02 , IXCP03 , IXCP04 , IXCP05 ) 

INTEGER ( IXCF06 , IXCF07 , IXCF08 , IXCF09 , IXCFIO ) 

INTEGER ( IXCFll , IXCF12 , IXCFl 3 , IXCF14 , IXCP15 ) 

INTEGER  ( IXCLOl ,  IXCL02  ,  IXCL03  ,  IXCL04  ,  IXCL05.) 

INTEGER ( IXCL06 , IXCL07 , IXCL08 , IXCL09 , IXCLIO ) 

INTEGER ( IXCLll , IXCL12 , IXCLl 3 , IXCL14 , IXCL15 ) 

INTEGER ( IXDFOl , IXDF02 , IXDFO  3 , IXDF04 , IXDF05 ) 

INTEGER ( IXDFO 6 , IXDF07 , IXDF08 , IXDF09 , IXDFIO ) 

INTEGER ( IXDFll , IXDF12 , IXDFl 3 , IXDF14 , IXDF15 ) 

INTEGER ( IXDLOl , IXDL02 , IXDLO  3 , IXDL04 , IXDL05 ) 

INTEGER ( IXDL06 , IXDL07 , IXDL08 , IXDL09 , IXDLIO ) 

INTEGER ( IXDLll , IXDL12 , IXDLl 3 , IXDL14 , IXDL15 ) 

INTEGER ( IXMONl , IXMON2 , IXMON3 , IXMON4 , IXMON5 ) 

INTEGER ( IXMON6 , IXMON7 , IXMON8 , IXMON9 ) 

INTEGER ( ITMPl , ITMP2 , IGAP ) 

REAL { XLAOl , XLA02 , XLAO  3 , XLA04 , XLA05 ) 

REAL ( XLA06 , XLA07 , XLA08 , XLA09 , XLAIO ) 

REAL ( XLAl 1 , XLAl 2 , XLAl 3 , XLAl 4 , XLAl 5 ) 

REAL ( XLBOl , XLB02 , XLBO  3 , XLB04 , XLB05 ) 

REAL ( XLBO  6 , XLBO  7 , XLBO  8 , XLB09 , XLBl 0 ) 

REAL ( XLB 1 1 , XLB 12,XLB13,XLB14, XLB 1 5 ) 

REAL { XLCO 1 , XLCO  2 , XLCO  3 , XLC04 , XLCO  5 ) 

REAL ( XLCO  6 , XLCO  7 , XLCO  8 , XLCO  9 , XLCl 0 ) 

REAL ( XLCl 1 , XLCl 2 , XLCl 3 , XLCl 4 , XLCl 5 ) 

REAL ( XLDOl , XLD02 , XLDO  3 , XLD04 , XLD05 ) 

REAL ( XLDO  6 , XLDO  7 , XLDO  8 , XLDO  9 , XLDl 0 ) 

REAL ( XLDl 1 , XLDl 2 , XLDl 3 , XLDl 4 , XLDl 5 ) 

REAL ( PXAO 1 , PXAO  2 , PXAO  3 , PXA04 , PXAO  5 ) 

REAL ( PXA06 , PXA07 , PXA08 , PXA09 , PXAIO ) 

REAL ( PXAl 1 , PXAl 2 , PXAl 3 , PXAl 4 , PXAl 5 ) 

REAL ( PXBOl , PXB02 , PXB03 , PXB04 , PXB05 ) 

REAL ( PXB06 , PXB07 , PXB08 , PXB09 , PXBl 0 } 

REAL ( PXBl 1 , PXBl 2 , PXBl 3 , PXBl 4 , PXBl 5 ) 

REAL ( PXCOl , PXC02 , PXCO  3 , PXC04 , PXC05 ) 

REAL ( PXCO 6 , PXCO 7 , PXCO 8 , PXCO 9 , PXCl 0 ) 

REAL ( PXCl 1 , PXCl 2 , PXCl 3 , PXCl 4 , PXCl 5 ) 

REAL ( PXDO 1 , PXDO  2 , PXDO  3 , PXD04 , PXDO  5 ) 

REAL ( PXD06 , PXD07 , PXDO 8 , PXD09 , PXDIO ) 

REAL ( PXDl 1 , PXDl 2 , PXDl 3 , PXDl 4 , PXDl 5 ) 

REAL ( XCENA , YCENA , XCENB , YCENB , XCENC , YCENC , XCEND , YCEND , YROCD ) 

REAL ( DORFF , DORFB , DPROP , DGEAR , DENGI ) 


REAL  ( DAUGL ,  DAUCai ,  DAUGS ,  DAGTF ,  DAGTB ) 

»EAL ( PI , XGAP ) 

* 

* 

*XXXXXXXXXXXXXXXXXXXXX  LOGICALS  xxxxxxxxxxxxxxxxxxxxxxxxxxxx* 

* 

* 

LG(1)=T 

* 

* 

*XXXXXXXXXXXXXXXXXXXXX  CIRCLE  CENTERS  &  DIAMETERS  XXXXXXXXXXX* 


* 

* 

. I»3. 141592654 

XCENA=140.0; 

RG{41)=XCENA 

CENA=113.0; 

RG(42)=YCENA 

CENB=XCENA; 

RG(43)=XCENB 

YCENB=YCENA; 

RG(44)=YCENB 

vCENC=XCENA+0 . 0 ; 

RG(45)=XCENC 

CENC=YCENA+9 . 0 ; 

RG(46)=YCENC 

aCEND=XCENA; 

RG(47)=XCEND 

YCEND=YCENA; 

RG(48)=YCEND 

ROCD=51 .0 

DORFF=189.4; 

RG(50)=DORPF 

’■>ORFB=167.8; 

RG(51)=DORFB 

•PROP=156.0; 

RG(52)=DPROP 

DGEAR=  27.0; 

RG(53)=DGEAR 

nENGI=  18.0; 

RG(54)=DENGI 

•AUGL=  67.0; 

RG(55)=DAUGL 

S<S>&LG&St&  ACTIVATE  WHEN  ENGINE  DOES  NOT  FALL  IN  LIP  &&&1T&6.& 
IG(60)=2 

DAUGS=  55.0;  RG ( 5  6 ) =DAUGS 

&&S.LG&S<&  ACTIVATE  WHEN  ENGINE  DOES  NOT  FALL  IN  LIP  &&&1F&&& 
IG(60)=3 

DAUGM*  60.0;  RG ( 5  6 ) =DAUGM 

DAUGS=  55.0;  RG(57)=DAUGS 

)AGTF=  56.0;  RG (  58  )  =DAGTF 

JAGTB=  34.0;  RG ( 5  9 ) =DAGTB 

XGAP=28.0;  RG(61)=XGAP 

#######  IGAP  MUST  BE  EVEN  ####### 

GAP=4;  IG(61)*IGAP 

* 

* 

*XXXXXXXXXXXXXXXXXXXXX  TYPE  1  DATA  XXXXXXXXXXXXXXXXXXXXXXXXXXX* 

* 


IRXA=7; 
;XAD=4  ; 
NX01=2 
■1X02=3 
1X0  3  =  3 
NX04=9 
NX05=9 
1X06  =  3 
i;X07  =  5 


IG(42)=NRXA 

IG(50)=NXAD 


;XAF01= 


1; 


IXAL01= 


NXCl 


IXAP02-IXAL01+1; 

IXAF03«IXAL02+1; 

IXAF04-IXAL03+1; 

IXAF05-IXAL04+1; 

IXAF06«IXAL05+1; 

IXAF07«IXAL06+1; 

XLA01=  16.000000; 
XLA02=  0.000000; 
XLA03=  0.000000; 
XLA04x:  XCENA; 

XLA05=  0.000000; 
XLA06«  0.000000; 
XLA07=280.000000; 

IG( 101 ) *IXAL01 ;RG{ 101 
IG(102)sIXAL02;RG(102 
IG(103)»IXAL03;RG(103 
IG(104)sIXAL04;RG(104 
IG(105)»IXAL05;RG(105 
IG( 106 ) =IXAL06 ;RG( 106 
IG(1D7 )*IXAL07;RG(107 
IG(117)®3 
* 


IXALO  2  B IXALO 1 -i-NXO  2 
IXAL03=IXAL02+NX03 
IXAL04»IXAL0  3-i-NX04 
IXAL05>IXAL04-t-NX05 
IXALO  6  B IXALO  5-t-KXO  6 
IXAL07=IXAL06+NX07 

PXAOl*  1.0 
PXA02«-1.2 
PXA03-  1.0 
PXA04S  1.0 
PXA05>  1.0 
PXA06-  1.0 
PXA07-  1.3 

)  -XLAOl ;RG( 121 ) »PXA01 
)=XLA02;RG(122)=PXA02 
)  -XLA03 ;RG( 123 )«PXA03 
)  »XLA04 ; RG ( 1 24 ) =PXA04 
)  =XLA05 ;RG ( 125 ) -PXA05 
)  =XLA06 ;RG( 126 ) =PXA06 
)  =XLA07 ;RG( 127 ) =PXA07 


*XXXXXXXXXXXXXXXXXXXXX  TYPE  2  DATA  XXXXXXXXXXXXXXXXXXXXXXXXXXX 
* 


NRXB=8; 

IXBPOl-IXAPOl; 
IXBP02*IXAL03/2+l; 
IXBF03-IXAF04; 
IXBF04=IXAP05-NXAD; 
IXBF05»=IXAF05; 
IXBF06*IXAP05+NXAD ; 
NXBD= ( IXAL07-IXAL05 ) 
IXBF07=IXAF06; 

IXBFO  8 = I XAFO  6 +NXBD ; 

XLB01=  0.000000; 
XLB02*  0.000000; 
XLB03-  0.000000; 
XLB04-  XCENB; 

XLB05-  0.000000; 
XLB06-  0.000000; 
XLB07-  0.000000; 
XLB08-  XLA07; 

IG( 141 ) -IXBLOl ;RG( 181 
IG(142)*IXBL02;RG(182 
IG(143)«IXBL03;RG(183 
IG( 144 ) =IXBL04 ;RG( 184 
IG(145)»IXBL05;RG(185 
IG(146)«IXBL06;RG(186 
IG( 147 ) -IXBL07 ;RG( 187 
IG(148)»IXBL08;RG(188 

IG(157)*3 

* 


IG(44)*NRXB 

IXBL01-IXAL03/2 

IXBL02«IXAL03 

IXBL03-IXAL04-NXAD 

IXBL04>:IXAL04 

IXBL05-IXAL04+NXAD 

IXBL06»IXAL05 

/2 

IXBL0.7=IXAL05+NXBD 

IXBL08=IXAL07 

PXBOl-  1.4 
PXB02—1.4 
PXB03-  1.0 
PXB04-  1.0 
PXB05-  1.0 
PXB06-  1.0 
PXB07-  1.4 
PXB08— 1.4 

) -XLBOl ;RG{ 201 )»PXB01 
) «XLB02 ;RG ( 202 ) -PXB02 
)=XLB03;RG(203)*=PXB03 
) =XLB04 ;RG ( 204 ) -PXB04 
) »XLB05 ;RG( 205 ) *PXB05 
) *XLB06 ;RG( 206 ) =PXB06 
)*XLB07;RG(207)-PXB07 
) *XLB08 ;RG( 208 ) •PXB08 


*  XXXXXXXXXXXXXXXXXXXXX 


TYPE  3  DATA  XXXXXXXXXXXXXXXXXXXXXXXXXXX 


IlXC-6  ; 

-XCFOl-IXBPOl; 

IXCF02-IXBP02; 

■XCP03=IXBF03; 

XCP04=IXBP05; 

IXCP05=IXBP07; 

TXCP06-IXBP08; 


IG(46)«NRXC 

IXCLOl-IXBLOl 

IXCL02*IXBL02 

IXCL03*IXBL04 

IXCL04=IXBL06 

IXCL05=IXBL07 

IXCL06=IXBL08 


..LC01=  0.000000; 

XLC02=  0.000000; 
.LC03=  XCEND; 
LC04*  0.000000; 

XLC05=  0.000000; 
"LC06-  XLA07; 


PXCOl-  PXBOl 
PXC02=  PXB02 
PXC03*  1.2 
PXC04=-1.2 
PXC05«  PXB07 
PXC06-  PXB08 


lG(181)=IXCL01;RG(261)»XLC01;RG(281)=PXC01 
IG(182)=IXCL02;RG(262)=XLC02;RG(282)«PXC02 
G(183)=IXCL03;RG(263)»XLC03;RG(283)=PXC03 
_G( 184 ) =IXCL04 ;RG( 264 ) -XLC04 ;RG( 2a4 ) -PXC04 
IG(185)=IXCL05;RG(265)=XLC05;RG(285)=PXC05 
G(186 )=IXCL06;RG(266)=XLC06;RG(286)=PXC06 
G(197)=3 
* 


* 

*XXXXXXXXXXXXXXXXXXXXX  TYPE  4  DATA 
* 


* 


RXD=4  * 

XDP01»IXCP01; 

IXDP02=IXCP03; 

"XDP03=IXCP04; 

XDP04=IXCP05; 


IG(48)»NRXD 

IXDL01»IXCL02 

IXDL02=IXCL03 

IXDL03-IXCL04 

IXDL04»IXCL06 


xxxxxxxxxxxxxxxxxxxxxxxxxxx* 


TTMP1=79+IG(60) 
TMP2=80+IG(60) 
«G(ITMP1) =116.0 
RG{ITMP2)=  92.0 
LD01=  0.000000; 

LD02=  XCEND; 
XLD03*  0.000000; 
”LD04=  0.000000; 


PXD01=-1.2 
PXD02=  PXC03 
PXD03-  PXC04 
PXD04»  1.2 


lG( 221 ) =IXDL01 ;RG( 341 )»XLD01 ;RG{ 361 )=PXD01 
IG(222)«IXDL02;RG(342)=XLD02;RG(362)=PXD02 
G(223)=IXDL03;RG(343)=XLD03;RG(363)=PXD03 
-G( 224 ) »IXDL04 ;RG( 344 ) *XLD04 ;RG( 364 ) =PXD04 

IG(237)=2 

* 


***********************************  **<r*************:*****1»r*********** 

*********  y-DIRECTION  GRIDING  ************ 

******************************************************************** 


*** 

*** 

NRYA 

Number 

of 

Y 

regions 

for 

Type 

1 

plane 

*** 

*** 

NRYB 

—  Number 

of 

Y 

regions 

for 

Type 

2 

plane 

*** 

*** 

NRYC 

Number 

of 

y 

regions 

for 

Type 

3 

plane 

"kick 

*** 

NRYD 

Number 

of 

Y 

regions 

fcr 

Type 

A 

*» 

plane 

k-kk 

**★ 

NOTE ;  The 

number  of  grid  cells  is  define  for  the  Type  i 

XXX 

**n 

plane  and  then  redistributed  for  the  other  types. 

XXX 

*** 

There  are  fourteen  available  regions,  some  may 

XXX 

•ktiK 

•  not 

be  used. 

XXX 

*** 

XXX 

*** 

NYOl 

— 

Number  of  cells  in  1st  region  ->  Floor  to 

XXX 

*** 

orifice 

XXX 

*** 

NY02 

— 

Number  of  cells  in  2nd  region  ->  Orifice  to 

XXX 

*** 

prop  tip 

XXX 

*** 

NX03 

— 

Number  of  cells  in  3rd  region  ->  Prop  tip  to 

XXX 

*** 

center  of  prop 

XXX 

★  Hr* 

NX04 

— 

Number  of  cells  in  6th  region  ->  Reduction 

XXX 

*** 

gear  to  prop  tip 

XXX 

X  A  A 

NY05 

— 

Nximber  of  cells  in  7th  region  ->  Prop  tip 

XXX 

X** 

to  orifice 

XXX 

*** 

NY06 

— 

Number  of  cells  in  8th  region  ->  Orifice  to 

XXX 

*** 

bottom  of  gap 

XXX 

*** 

NY07 

— 

Nximber  of  cells  in  9th  region  ->  Bottom  of 

XXX 

X** 

gap  to  top  of  gap 

XXX 

XXX 

NY08 

— 

Niimber  of  cells  in  10th  region  ->  Top  of  gap 

XXX 

XXX 

to  roof 

XXX 

XXX 

NY09 

— 

Number  of  cells  in  11th  region  ->  Spare 

XXX 

XXX 

NYIO 

— 

Number  of  cells  in  11th  region  ->  Spare 

XXX 

XXX 

NYU 

— 

Number  of  cells  in  llth  region  ->  Spare 

XXX 

XXX 

NY12 

— 

Number  of  cells  in  12th  region  ->  Spare 

XXX 

XXX 

NY  13 

— 

Number  of  cells  in  13th  region  ->  Spare 

XXX 

XXX 

NY14 

— 

Number  of  cells  in  14th  region  ->  Spare 

XXX 

XXX 

XXX 

XXX 

NOTE:  The 

regions  for  the  other  4  Types  will  now  also 

XXX 

XXX 

be  defined. 

XXX 

XXX 

TYPE  2 

XXX 

XXX 

Region 

1 

—  Floor  to  half  distance  augmenter  tube 

XXX 

XXX 

Region 

2 

Half  distance  augmenter  tube  to  aug  tube 

XXX 

XXX 

Region 

3 

—  Augmenter  tube  to  engine 

XXX 

XXX 

Region 

4 

—  Engine  to  midpoint  engine 

XXX 

XXX 

Region 

5 

Midpoint  engine  to  engine 

XXX 

XXX 

Region 

6 

Engine  to  augmenter  tube 

XXX 

XXX 

Region 

7 

Augmenter  tube  to  half  distance  aug  tube 

XXX 

XXX 

Region 

8 

Half  distance  augmenter  tube  to  roof 

XXX 

XXX 

TYPE  3 

XXX 

XXX 

Region 

1 

—  Floor  to  half  distance  augmenter  tube 

XXX 

XXX 

Region 

2 

Half  distance  augmenter  tube  to  aug  tube 

XXX 

XXX 

Region 

3 

—  Augmenter  tube  to  midpoint  aug  tube 

XXX 

XXX 

Region 

4 

—  Midpoint  augmenter  tube  to  aug  tube 

XXX 

XXX 

Region 

5 

—  Augmenter  tube  to  half  distance  aug  tube 

XXX 

XXX 

Region 

6 

—  Half  distance  augmenter  tube  to  roof 

XXX 

XXX 

TYPE  4 

XXX 

XXX 

Region 

1 

Floor  to  augmenter  tube 

XXX 

XXX 

Region 

2 

—  Augmenter  tube  to  midpoint  aug  tube 

XXX 

XXX 

Region 

3 

Midpoint  augmenter  tube  to  aug  tube 

XXX 

XXX 

Region 

4 

Augmenter  tube  to  center  of  curvature 

XXX 

XXX 

Region 

5 

Center  of  curvature  to  roof 

XXX 

XXX 

TYPE  5 

XXX 

XXX 

Region 

1 

—  Wall  to  wall 

XXX 

XXX 

XXX 

XXX 

NYAD 

One-half  number  of  cells  in  Y-direction  used 

XXX 

XXX 

for  the  reduction  gear/engine 

XXX 

XXX 

NYBD 

-- 

Number  of  cells  in  Y-direction  used  for 

XXX 

X  X  y 

rearrangement  of  three  regions  into  two 

XXX 

XXX 

NOTE:  This 

last  two  items  have  corresponding  parameters 

XXX 

for  the  X-dlrectlon.  Generally  they  will  be  the 
the  same. 


kkk 

kkk 

kkk 

lYAF** 

*** 

lYAL** 

*** 

lYBF** 

*** 

lYBL** 

*** 

lYCF** 

kkk 

lYCL** 

kkk 

lYDF** 

kkk 

lYDL** 

kkk 

kkk 

lYMON* 

kkk 

kkk 

YLA** 

kkk 

YLB** 

*** 

YLC** 

kkk 

YLD** 

kkk 

kkk 

PYA** 

kkk 

PYB** 

kkk 

PYC** 

kkk 

PYD** 

kkk 

First  cell  number  of  **  region  Type  l 
Last  cell  number  of  **  region  Type  1 
First  cell  number  of  **  region  Type  2 
Last  cell  number  of  **  region  Type  2 
First  cell  number  of  **  region  Type  3 
Last  cell  number  of  **  region  Type  3 
First  cell  number  of  **  region  Type  4 
Last  cell  number  of  **  region  Type  4 

Location  of  *  monitoring  point  (9  extra) 

Length  to  end  of  **  region  Type  1  (in) 

Length  to  end  of  **  region  Type  2  (in) 

Length  to  end  of  **  region  Type  3  (in) 

Length  to  end  of  **  region  Type  4  (in) 

Clustering  factor  of  **  region  Type  l 
Clustering  factor  of  **  region  Type  2 
Clustering  factor  of  **  region  Type  3 
Clustering  factor  of  **  region  Type  4 


*** 

*** 

*** 

*** 

•k** 

Ickk 

kk* 

*** 

kkk 

kkk 

kkk 

kkk 

kkk 

kkk 

kkk 

kkk 

kkk 

kkk 

kkk 

kkk 

kkk 

kkk 


kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 


k 


* 

♦YYYYYYYYYYyYYYYYYYYYY  DECLARE  Y  YYYYYYYYYYYYYYYYYYYYYYYYYYYYYY* 

★ 

* 

xNTEGER ( NRYA , NRYB , NRYC , NRYD ) 

INTEGER ( NYAD , NYBD ) 

INTEGER (NYDl ,NY02 ,NY03 ,NY04 ,NY05 ,NY06 ,NY07 ,NY08 ,NY09 ,NY10 ) 

INTEGER ( NYl 1 , NYl 2 , NYl 3 , NYl 4 ) 

INTEGER ( I YAFOl , IYAF02 , IYAF03 , IYAF04 , IYAF05 ) 

INTEGER ( IYAF06 , IYAF07 , IYAF08 , IYAF09 , lYAFlO ) 

INTEGER ( lYAFl 1 , I YAFl 2 , I YAFl 3 , I YAFl 4 , I YAFl 5 ) 

INTEGER ( lYALOl , IYAL02 , lYALO  3 , iyAL04 , IYAL05 ) 

INTEGER ( IYAL06 , IYAL07 , IYAL08 , IYAL09 , lYALlO ) 

INTEGER ( lYALll , IYAL12 , lYALl 3 , IYAL14 , IYAL15 ) 

INTEGER ( lYBFOl , IYBF02 , IYBF03 , IYBF04 , IYBF05 ) 

INTEGER ( IYBF06 , IYBF07 , IYBF08 , IYBF09 , lYBFlO ) 

INTEGER ( I YBFl 1 , I YBFl 2 , I YBFl 3 , I YBFl 4 , lYBFl 5 ) 

INTEGER ( lYBLOl , IYBL02 , lYBLO  3 , IYBL04 , lYBLOB ) 

INTEGER( IYBL06 ,iyBL07 , IYBL08 ,IYBL09  ^lYBLlO ) 

'INTEGER  ( I YBLl  1 ,  lYBLl  2  ,  lYBLl  3 , 1 YBLl  4 , 1 YBLl  5  ) 

INTEGER ( lYCFOl , IYCF02 , iyCF03 , iyCF04 , lYCFOB ) 

INTEGER ( IYCF06 , iyCF07 , IYCF08 , IYCF09 , lYCTlO ) 

INTEGER ( lYCFl 1 , lYCFl 2 , lYCFl 3 , I YCFl 4 , lYCFl 5 ) 

INTEGER ( lYCLOl , IYCL02 , lYCLO  3 , IYCL04 , IYCL05 ) 

-NTEGER ( IYCL06 , IYCL07 , iyCL08 , IYCL09 , lYCLlO ) 

INTEGER ( lYCLl 1 , IYCL12 , lYCLl 3 , I YCLl 4 , lYCLl 5 ) 

INTEGER ( lYDFOl , IYDF02 , IYDF03 , IYDF04 , IYDF05 ) 

INTEGER ( IYDF06 , IYDF07 , IYDF08 , IYDF09 , lYDFlO ) 

INTEGER ( lYDFl 1 , I YDFl 2 , I YDFl 3 , I YDFl 4 , I YDFl 5 ) 

■INTEGER  ( lYDLOl ,  IYDL02  ,  lYDLO  3  ,  iyDL04  ,  IYDL05  )  • 

INTEGER ( IYDL06 , IYDL07 , IYDL08 , IYDL09 , lYDLlO ) 
iINTEGER  ( lYDLl  1  ,  IYDL12  ,  lYDLl  3  ,  IYDL14  ,  lYDLl  5  ) 

INTEGER ( lYMONl , IYM0N2 , IYM0N3 , IYMON4 , IYMON5 ) 

INTEGER ( IYMON6 , IYM0N7 , IYM0N8 , IYMON9 ) 


REAL ( YLAO 1 , YLAO  2 , YLAO  3 , YLA04 , YLAO  5 ) 

REAL ( YLA06 , YLA07 , YLA08 , YLA09 , YLAl 0 ) 

REAL ( YLAl 1 , YLAl 2 , YLAl 3 , YLAl 4 , YLAl 5 ) 

REAL ( YLBOl , YLB02 , YLBO  3 , YLB04 , YLB05 ) 

REAL ( YLB06 , YLB07 , YLB08 , YLB09 , YLBl 0 ) 

REAL ( YLBl 1 , YLB12 , YLBl 3 , YLBl 4 , YLBl 5 ) 

REAL ( YLCOl , YLC02 , YLCO  3 , YLC04 , YLC05 ) 

REAL ( YLCO  6 , YLCO  7 , YLCO  8 , YLCO  9 , YLCl 0 ) 

REAL ( YLCl 1 , YLCl 2 , YLCl 3 , YLCl 4 , YLCl 5 ) 

REAL ( YLDO 1 , YLD02 , YLDO  3 , YLD04 , YLDO  5 ) 

REAL ( YLDO  6 , YLDO  7 , YLDO  8 , YLDO  9 , YLDl 0 ) 

REAL ( YLDl 1 , YLDl 2 , YLDl 3 , YLDl 4 , YLDl 5 ) 

REAL ( PYAOl , PYA02 , PYAO  3 , PYA04 , PYA05 ) 

REAL ( PYAO  6 , PYAO  7 , PYAO  8 , PYAO  9 , P YAl 0 ) 

REAL ( PYAl 1 , PYAl 2 , PYAl 3 , PYAl 4 , PYAl 5 ) 

REAL ( PYBOl , PYB02 , PYBO  3 , PYB04 , PYB05 ) 

REAL ( PYB06 , PYB07 , PYB08 , PYB09 , PYBIO ) 

REAL (PYB11,PYB12,PYB13,PYB14,PYB15) 

REAL ( PYCO 1 , PYCO  2 , PYCO  3 , PYC04 , PYCO  5 ) 

REAL ( PYCO  6 , PYCO  7 , PYCO  8 , PYCO  9 , PYCl 0 ) 

REAL ( PYCl 1 , PYCl 2 , PYCl 3 , PYC14 , PYCl 5 ) 

REAL ( PYDOl , PYD02 , PYDO  3 , PYD04 , PYD05 ) 

REAL ( PYDO 6 , PYDO 7 , PYDO 8 , PYDO 9 , PYDIO ) 

REAL ( PYDl 1 , PYD12 , PYDl 3 , PYD14 , PYD15 ) 

* 

ic 

♦YYYYYYYYYYYYYYYYYYYYY  TYPE  1  DATA  YYYYYYYYYYYYYYYYYYYYYYYYYYY* 
* 


* 


NRYA*8; 

IG(43)=NRYA 

NYAD=4 ; 

IG(51)«NYAD 

NY01»5 

NY02=3 

NY03=9 

NY04=9 

NY05=3 

NY06=3 

NY07=2 

NY08=2 

IYAF01=  1; 

IYAL01=  NYOl 

IYAF02-IYAL01+1; 

IYAL02=IYAL01+NY02 

IYAF03-IYAL02+1; 

IYAL03-IYAL02+NY03 

IYAF04-IYAL03+1; 

IYAL04=IYAL03+NY04 

IYAF05-IYAL04+1; 

IYAL05=IYAL04+NY05 

IYAF06-IYAL05+1 ; 

IYAL06=IYAL05+NY06 

IYAF07«IYAL06+1; 

IYAL07=IYAL06+NY07 

IYAF08-IYAL07+1; 

IYAL08=IYAL07+NY08 

YLAOl*  0.000000; 

PYA01=  1.0 

YLA02=  0.000000; 

PYA02=  1.0 

YLAO 3=  YCENA; 

PYAO 3=  1.0 

YLA04*  0.000000; 

PYA04=  1.0 

YLA05*  0.000000; 

PYA05=  1.0 

YLA06»238. 000000 ; 

PYA06=  1.0 

YLA07»244.000000; 

PYA07=  1.0 

YLA08*294 .000000; 

PYA08=  1.0 

IG(121 )=IYAL01 ;RG( 141 )=YLA01;RGi 161 )=PYA01 
IG(122)*IYAL02;RG(142)=YLA02;RG( 162)=PYA02 


1G(123)»IYAL03;RG(143)»YLA03;RG(163)«PYA03 
TG( 124 ) «IYAL04 ;RG( 144 ) ■YLA04 ;RG( 164 )«PYA04 
;G(125)=IYAL05;RG(145)=YLA05;RG(165)»PYA05 
-;G(  126  )  -IYAL06  ;RG(  146  )  *YLA06  ;RG(  166  )»PYA06 
IG(127)-IYAL07;RG(147)*YLA07;RG(167)»PYA07 
:G(128)=IYAL08;RG(  148  )  «=YLA08  ;RG(  168  )  =PYA08 
;G(137)=2 
★ 


*  Y  Y  YY  Y  YY  Y  Y  Y  Y  Y  Y  Y  Y  Y  Y  Y  Y  YY 


TYPE  2  DATA 


yYYYYyYYYYYYYYYYYYYYYYYYYYY* 


IRYB=8; 

;ybfoi=iyafoi; 

IYBF02=IYAL02/2+l ; 
~YBF03=IYAF03; 
;YBF04=IYAF04-NYAD ; 
IYBF05=IYAF04; 
TYBF06=IYAF04+NYAD; 
rYBD= ( IYAL08-IYAL04 ) /2 
JYBF07=IYAF05; 
IYBF08=IYAF05+NYBD; 


IG(45) 

lYBLOl 

IYBL02 

IYBL03 

IYBL04 

IYBL05 

IYBL06 


NRYB 

IYAL02/2 

IYAL02 

IYAL03-NYAD 

IYAL03 

IYAL03+NYAD 

IYAL04 


IYBL07=IYAL04+NYBD 

IYBL08=IYAL08 


'LB01  = 
yLB02= 
”LB03= 
:LB04= 
YLB05= 
YLB06>= 
'LB07  = 
.’LB08=  ' 

;G(161) 
;G(162) 
IG(163) 
TG(164) 
:G(165) 
1G(166) 
IG(167 ) 
:G(168) 
;G(177) 


0.000000; 
0.000000; 
0.000000; 
YCENB ; 
0.000000; 
0.000000; 
0.000000; 
YLA08; 


PYB01=  1.4 
PYB02=-1 .4 
PYB03=  1.0 
PYB04=  1.0 
PYB05=  1.0 
PYB06*  1.0 
PYB07-  1.4 
PYB08=-1.4 


lYBLOl 

IYBL02 

IYBL03 

IYBL04 

IYBL05 

IYBL06 

IYBL07 

IYBL08 

^3 


;RG( 

;RG( 

;RG( 

;RG( 

;RG( 

;RG( 

;RG( 

;RG( 


221): 

222): 

223) : 

224) 

225) 

226) 
227  ) 
228) 


=YLB01;RG( 

=YLB02;RG( 

YLB03;RG( 

YLB04;RG( 

YLB05;RG( 

YLB06;RG{ 

YLB07;RG( 

YLB08;RG( 


241) 

242) 

243) 

244) 

245) 
246  ) 

247) 

248) 


*PYB01 

=PYB02 

PYB03 

PYB04 

PYB05 

PYB06 

PYB07 

PYB08 


*YYYYYYYYYYYYYYYYYYYYY 


TYPE  3  DATA  YYYYYyyyyYYYYYYYYYYYYYYYYYY* 


rRYC=6; 

xYCFOl^IYBFOl 

IYCF02=IYBF02 

YCF03--IYBF03 

yCF04=IYBF05 

IYCF05=IYBF07 

'yCF06=IYBF08 


IG(47)s 
lYCLOl: 
IYCL02> 
IYCL03  = 
IYCL04= 
IYCL05= 
IYCL06= 


NRYC 

lYBLOl 

IYBL02 

IYBL04 

IYBL06 

iyBL07 

IYBL08 


YLC01=  0.000000; 
VLC02=  0.000000; 

LC03=  YCEND; 
.LC04=  0.000000; 

VLC05=  O.OOOOOG; 
LC06=  YLA08; 


PyC01=  PYBOl 
PyC02=  PYB02 
PYC03=  1.2 
PYC04=-1.2 
PYC05=  PYBO? 
PYC06=  PYB08 


IG{201)=iyCL01;RG( 301 ) =YLC01 ;RG( 321)=PYC01 
IG(202)=IYCL02;RG(302)«YLC02;RG( 322)*PYC02 
IG(203)=IYCL03;RG(303)*YLC03;RG( 323)*PYC03 
IG ( 204 ) =I YCL04 ; RG ( 3  04 ) = YLC04 ; RG ( 324 ) »PYC04 
IG(205)=IYCL05;RG( 305 ) *YLC05 ;RG( 325)=PYC05 
IG(206)=IYCL06;RG( 306 ) =YLC06 ;RG ( 326 ) =PYC06 
IG{217)=3 
* 

* 

*YYYYYYYYYYYYYYYYYYYYY  TYPE  4  DATA  YYYYYYYYYYYYYYYYYYYYYYYYYYY* 
* 

* 

NRYD=4 ; 

IYDF01=IYCF01 
iyDF02=iyCF03 
IYDF03=IYCF04 
IYDF04=IYCF05 


IG(49)=NRYD 

IYDL01=IYCL02 

iyDL02=iyCL03 

IYDL03=IYCL04 

IYDL04=IYCL06 


YLD01=  0.000000;  PYD01=-l-4 

YLD02=  YCEND;  PYD02=:  PYC0  3 

YLD03=  0.000000;  pyD03=  PYC04 

YLD04=  YCEND+YROCD;  PYD04=  1.2 


IG(241)=IYDL01;RG( 381 )=YLD01;RG(401 )*PYD01 
IG( 242 ) =IYDL02 ;RG( 382 ) =YLD02 ;RG( 402 ) =PYD02 
IG(243)=iyDL03;RG( 383 ) *YLD03 ;RG( 403 ) *PYD03 
IG( 244 ) =IYDL04 ;RG( 384 ) =YLD04 ;RG( 404 ) =PYD04 

IG(257)=2 

* 

* 

******************************************************************** 

*********  2-DIRECTION  GRIDING  ************ 

******************************************************************** 
***  *** 


***  NOTE:  With  the  X-Y  gird  information,  several  planes  of 
***  grid  points  will  be  produced  in  the  SATLIT.  In 

***  this  section  the  user  must  specify  how  these 

***  planes  are  then  stacked,  blended,  or  rotated. 

***  There  will  be  a  plane  of  data  for  the  front  face 

***  of  each  of  the  following  regions. 

*** 


*** 

*** 

*** 

*** 

*** 

*** 

*** 


***  NCS  —  Number  of  regions  in  Z-direction  *** 

***  *** 


*** 


*** 


*** 
*** 
*** 
*** 
*** 
*** 
*** 
*** 
*** 
*** 
*** 
*** 
*** 
**  * 
*** 


NZOl 
NZ02 
NZ0  3 
NZ04 
NZ05 
NZ06 


Number  of  cells  in  1st  region  ->  End  of 

baffles  to  half  distance  orifice 

Number  of  cells  in  2nd  region  ->  Half 

distance  orifice  to  start  of  orifice 

Number  of  cells  in  3rd  region  ->  Start  of 

orifice  to  orifice  angle 

Number  of  cells  in  4th  region  ->  Orifice 

angle  to  end  of  orifice 

Number  of  cells  in  5th  region  ->  End  of 

orifice  to  start  of  prop 

Number  of  cells  in  6th  region  ->  Start  of 
prop  to  end  of  prop 

Number  of  cells  in  7th  region  ->  End  of  prop 

to  start  of  reduction  gear 

Number  of  cells  in  8th  region  ->  Start  of 


•kit* 

*** 

★  *  * 
kkk 
*** 
★  *  * 
★  *  * 

kkk 
kkic 
★  ★  * 


NZ08 


*** 


NZ09 


NZIO 


NZll 


NZ12 


NZ13 


NZ14 


NZ15 


NZ16 


NZ17 


NZ18 

NZ19 

NZ20 

NZ21 

NZ22 

NZ23 

NZ24 

NZ25 


reduction  gear  to  end  of  reduction  gear 
Number  of  cells  In  9th  region  ->  End  of 
reduction  gear  to  start  of  engine 
Number  of  cells  In  10th  region  ->  Start  of 
engine  to  end  of  engine  and  augmenter  lip 
Number  of  cells  In  11th  region  ->  Augmenter 
lip  to  start  of  augmenter*  sleeve 
Number  of  cells  In  12th  region  ->  Start  of 
augmenter  sleeve  to  end  augmenter  sleeve 
Nximber  of  cells  In  13th  region  ->  End  of 
augmenter  sleeve  to  augmenter  tube 
ASSUMPTION:  This  Is  an  arbitrary  region  to 
make  up  for  the  difference  In  diameter. 

Number  of  cells  In  20th  region  ->  Augmenter 
tube  to  start  of  augmenter  tube  reduction 
Number  of  cells  In  15th  region  ->  Start  of 
augmenter  tube  reduction  to  end  of  reduction 
Number  of  cells  In  16th  region  ->  End  of 
augmenter  tube  reduction  to  start  of  baffles 
Number  of  cells  In  17th  region  ->  Start  of 
baffles  to  start  of  triangular  room 
ASSUMPTION:  The  start  of  the  triangular  room 
has  be  'chopped'  off  for  orthogonality 
Number  of  cells  In  18th  region  ->  Start  of 
triangular  room  to  start  of  chimney 
Number  of  cells  In  19th  region  ->  Start  of 
of  chimney  to  end  of  augmenter ' tube 
Number  of  cells  In  20th  region  ->  End  of 
augmenter  tube  to  end  of  domain 
Number  of  cells  in  21th  region  ->  Spare 

Number  of  cells  in  22th  region  ->  Spare 

Number  of  cells  in  23th  region  ->  Spare 

Number  of  cells  in  24th  region  ->  Spare 

Number  of  cells  in  25th  region  ->  Spare 


IZF** 

IZL** 


ZL** 


PZ** 


ITRI 


First  cell  number  of  **  region 
Last  cell  number  of  **  region 


IZMON*  —  Location  of  *  monitoring  point  (9  extra) 


Length  to  end  of  **  region  (in) 

Clustering  factor  of  **  region 

Number  of  cells  in  straight  section  of 
augmenter  tube  in  chimney 

Length  of  straight  section  of  augmenter  tube 
in  chimney 

Height  at  start  of  baffles  in  chimney 


*ZZZZZZZ2ZZZZZZZZZZZZZ  DECLARE  Z  ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ* 


NTEGER 'NCS , ITRI  ) 

NTEGER(NZ01 ,NZ02 ,NZ03 ,NZ04 ,NZ05 ,NZ06,NZ07 .NZ08 ,NZ09 ,NZ10 ) 


INTEGER (NZ11,NZ12,NZ1 3, NZ14,NZ15,NZ16,NZ17,NZ18,NZ19,NZ20) 

INTEGER (NZ21 ,NZ22 ,NZ23 ,NZ24 ,NZ25 ) 

INTEGER ( IZFOl , IZF02 , IZF03 , IZF04 , IZF05 ) 

INTEGER ( I2F06 , IZF07 , IZF08 , IZF09 , IZFIO ) 

INTEGER ( IZFll , IZF12 , IZF13 , IZF14 , IZFIS ) 

INTEGER ( IZFl 6 , IZFl 7 , IZFl 8 , IZFl 9 , IZF20 ) 

INTEGER ( IZF21 , IZF22 , IZF23 , IZF24 , IZF25 ) 

INTEGER  C IZLOl , IZL02 , IZLO  3 , IZL04 , IZLOS ) 

INTEGER ( IZL06 , IZL07 , IZL08 , IZL09 , IZLIO ) 

INTEGER( IZLll , IZL12 , IZL13 , IZL14 , IZL15 ) 

INTEGER ( IZL16 , IZL17 , IZL18 , IZL19 , IZL20 ) 

INTEGER ( IZL21 , IZL22 , IZL23 , IZL24 , IZL25 ) 

INTEGER ( IZMONl , IZMON2 , IZMON3 , IZMON4 , IZMON5 ) 

INTEGER ( IZMON6 , IZMON7 , IZMON8 , IZMON9 ) 

REAL ( ZLOl , ZL02 , ZLO  3 , ZL04 , ZL05 ) 

REAL ( ZL06 , ZL07 , ZL08 , ZL09 , ZLIO ) 

REAL ( ZLll , ZL12 , ZLl 3 , ZL14 , ZL15 ) 

REAL ( ZL16 , ZL17 , ZL18 , ZL19 , ZL20 ) 

REAL ( ZL21 , ZL22 , ZL23 , ZL24 , ZL25 ) 

REAL(PZ01,PZ02,PZ03,PZ04,PZ05) 

REAL(PZ06,PZ07,PZ08,PZ09,PZ10) 

REAL(PZ11,PZ12,PZ13,PZ14,PZ15) 

REAL(PZ16,PZ17,PZ18,PZ19,PZ20) 

REAL(PZ21,PZ22,PZ23,PZ24,PZ25) 

REAL(ZPT,ZCH) 

ic 

ic 

*ZZZZZZZZZZZZZZZZZZZZZ  GEOMETRY  £>  STACKING  INFO  ZZZZZZZZZZZZZZZ* 

* 

* 

NCS*20; 

NZ01=4 
NZ02=4 
NZ03»4 
NZ04=2 
NZ05=3 
NZ06=1 
NZ07=4 
NZ08=3 
NZ09=3 
NZ10=5 
N211=2 
NZ12=5 
NZ13=1 
NZ14*4 
NZ15*3 
NZ16=4 
NZ17=5 
NZ18*2 

####### 

ITRI=1; 

N219=ll 
NZ20=5 

ZPT=9.0;  RG(90)=ZPT 

ZCH= 317.0;  RG(91)=ZCH 

I2F01=  1;  IZL01=  NZOl 

I2F02  =  IZL01  +  1  ;  IZL02  =  IZL01+NZ02 

I2F03  =  IZL02+1 ;  IZLO 3  =  IZL02+NZ0 3 


IG(501)=NCS 


DIFFERENCE  BETWEEN  NZ19  AND  ITRI  MUST  BE  EVEN  ####### 
IG(90)=ITRI 


IZF04> 

TZP05. 

:ZP06. 

xZP07. 

IZP08> 

:zP09« 

CZF10» 

IZF11« 

IZF12> 

CZP13« 

IZF14« 

IZF15« 

[ZF16> 

XZF17» 

IZP18« 

lZF19« 

CZF20» 


IZL03-fl 

IZL04-fl 

IZL05+1 

IZL06-t-l 

IZL07+1 

IZL08+1 

IZL09+1 

IZLlO+1 

IZLll+1 

IZL12+1 

IZL13+J 

IZL14+1 

IZL15+1 

IZLie-f-l 

IZL17+1 

IZL18+1 

IZL19+1 


IZL04> 

IZL05* 

IZL06> 

IZL07. 

IZL08> 

IZL09> 

IZL10> 

IZL11= 

IZL12> 

IZL13* 

IZL14> 

IZL15> 

IZL16* 

IZL17« 

IZL18< 

IZL19* 

IZL20> 


>IZL03-i'NZ04 

‘IZL04-I-NZ05 

>IZL054-NZ06 

IZL06+NZ07 

IZL07+N208 

IZL08-I-NZ09 

IZL09+N210 

IZL10+N211 

IZLll-fNZ12 

IZL12+N213 

IZL13-I-NZ14 

IZL14+NZ15 

IZL15+NZ16 

IZL16+NZ17 

IZL17+N218 

IZL18-t-NZ19 

IZL19+N220 


ZLOl-102.5;  PZ01« 

!L02>205.0;  PZ02= 

2L03=215.8;  PZ03* 

ZL04=217.8;  PZ04s 

note  prop  width  5"  ass 
!L05=231.3;  PZ05* 

ZL06»236.3;  PZOe^ 

■2L07=247.8;  P207« 

:L08«267.8;  PZ08* 

ZL09=298.8;  PZ09< 

ZL10*394.8;  PZ10« 

2L11=400.8;  PZ11« 

ZL12=430.8;  PZ12> 

ZL13=436.8;  PZ13« 

ZL14«532.8;  PZ14* 

2L15-603.8;  PZIS* 

ZL16>689.8;  PZ16« 

ZL17*842.3;  PZ17= 

ZL18»871.8;  PZ18= 

ZL19-991.8;  PZ19= 

ZL20=991.8;  PZ20= 


CG{511)i 
CG(512)i 
CG{513). 
[G(514)< 
:G(51S). 
:G(516)> 
:G(517). 
:G(518). 
:G(519)  = 
:G(520)i 
:G(521)  = 
:G(522)s 
:G(523)» 
:G(524)« 
:G(525)> 
;G(526)> 
:G(527). 
:G(528)« 
G(529)* 
G(530)> 


:NZ01 

>NZ02 

•NZ03 

>NZ04 

•NZ05 

•NZ06 

«NZ07 

cNZ08 

>NZ09 

=NZ10 

=NZ11 

>NZ12 

=NZ13 

■NZ14 

■NZ15 

:NZ16 

.NZ17 

iNZ18 

NZ19 

NZ20 


RG(511  )■ 

RG(512)^ 

RG(513)' 

RG(514) 

RG(515) 

RG(516) 

RG{517) 

RG(518) 

RG(519)  = 

RG(520) 

RG(521) 

RG{522) 

RG(523)  = 

RG(524) 

RG(525) 

RG(526) 

RG(527) 

RG(528) 

RG( 529 ) 

RG(530) 


:ZL01 
:ZL02 
•  ZL03 
ZL04 
ZL05 
ZL06 
ZL07 
ZL08 
ZL09 
ZLIO 
ZLll 
2L12 
ZL13 
ZL14 
ZL15 
ZL16 
ZL17 
ZL18 
ZL19 
ZL20 


:RG(541) 
:RG(542) 
:RG(543) 
:RG(544) 
RG(545) 
RG(546) 
RG(547) 
RG(548) 
RG(549) 
RG(550) 
RG(551 ) 
RG(552) 
RG(553) 
RG(554 ) 
RG(555) 
RG(556) 
RG(557) 
RG(558) 
RG(559) 
RG(560)^ 


=PZ01 

=PZ02 

-PZ03 

-PZ04 

-PZ05 

■PZ06 

»PZ07 

-PZ08 

-PZ09 

=PZ10 

*PZ11 

*PZ12 

*PZ13 

=PZ14 

=PZ15 

=PZ16 

=PZ17 

=PZ10 

=PZi9 

=PZ20 


##«##*«  IG  WHERE  CHIMNEY  STARTS  «#««*«« 

IG(537)*:19 

IG(541)-:1;IG(571)=61;IG(601)-61 

IG(542)-2;IG(572)=61;IG(602)-62 

IG(543)*2;IG(573)=62;IG(603)«63 

IG(544)=1;IG(574)=63;IG(604)=63 

IG(545)=l;IG(575)-63;IG(605)-63 

IG(546)»l;IG(576)«63;IG(606)-63 

IG(547)*2;IG(577)=63;IG(607)=64 

IG(548)»l;IG(578)»64;IG(608-)«64 

IG(549)«2;IG(579)*64;IG(609)»65 

IG(550)=2;IG(580)»65;IG(610)-66 

IG(551)»2;IG(581)»66;IG(611)»67 

IG(552)*2;IG(582)»67;IG(612)-68 

IG(553)=2;IG(583)=68;IG(613)-69 

IG(554)*=1;IG(584)-69;IG(614)»69 

IG(555)*2;IG(585)=69;IG(615)e70 

IG(556)=l;IG(586)*70;IG(616)-70 

IG{557)»2;IG(587)-70;IG(617)-71 

IG(558)=2;IG(588)»71;IG(618)«72 

IG(559)=3;IG(589)=72;IG(619)=72 

IG(560)=4;IG(590)=72;IG(620)=73 

GROUP  2.  Transience;  time-step  specification 

GROUP  3.  X-direction  grid  specification 
NX*NX01+NX02+NX03+NX04+NX05+NX06+NX07+NX08+NX09 
NX=NX+NX1 0+NXl 1 +NX1 2+NXl 3+NXl 4 

GROUP  4.  Y-direction  grid  specification 
NY«NY01+NY02+NY03+NY04+NY05+NY06+NY07+NY08+NY09 
NY»NY+NY10+NY11+NY12+NY13+NY14 

GROUP  5.  Z-direction  grid  specification 
NZ*N201+NZ02+NZ03+NZ04+NZ05+NZ06+N207+NZ08+NZ09+NZ10+N211 
N2 =NZ +NZ 1 2+NZ 1 3  +NZ 1 4+NZ 1 5  +NZ 1 6  +NZ 1 7  +NZ 1 8  tNZ 1 9 +NZ  2  0+NZ  2 1 
NZ=NZ+NZ22+NZ23+NZ24+NZ25 

GROUP  6.  Body-fitted  coordinates  or  grid  distortion 
3FC=T;NONORT=T 
IG(1)=2 
SATRUN ( NECL ) 

READCO(GRID) 

GROUP  7.  Variables  stored,  solved  &  named 
S0LUTN(P1,Y,Y,Y,N,N,N) 

S0LVE(U1,V1,W1) 

S0LUTN(U1,Y,Y,N,Y,N,N) 

S0LUTN(V1,Y,Y,N,Y,N,N) 

S0LUTN(W1,Y,Y,N,Y,N,N) 

SOLVE (HI, Cl) 

STORE (RHOl) 

STORE(C3,C4,C5,C6,C7) 

STORE (U2,V2,W2,C8,C9, CIO, Cll ) 

NAME { C4 ) =TEMP 
NAME(C5)=CP 
NAME(C8)*PH20 
NAME ( C9 ) =TFAR 
NAME(C10)=RHOE 
NAME(C11 )=SPAR 
TURMOD ( KEMODL ) 

STORE ( ENUT ) 

KELIN=1 


GROUP  8.  Terms  (In  differential  equations)  &  devices 
■^ERMS  (H1,N,P,P,P,P,P) 

GROUP  9.  Properties  of  the  medium  (or  media) 

* 


******************************************************************** 

itlftcf!***** 

USER  DEFINED  VARIABLES  ************ 

****ie********************1i***1cit******-kic1c1i*-k**ic**1c***1fit*ie*1c*1e*****ifk* 

*** 

*** 

*** 

NOTE: 

These  are  the  variables  used  to  define  this 

kkk 

*** 

problem. 

kkk 

*** 

kkk 

*** 

CONDI 

— 

k  for  mineral  fiber  (BTU/hr/ft/F) 

kkk 

*** 

C0ND2 

— 

k  for  steel  (BTU/hr/ft/F) 

kkk 

*** 

THICKl 

— 

Thickness  of  mineral  fiber  (in) 

kkk 

*** 

THICK 2 

— 

Thickness  of  steel  (in) 

*** 

*** 

TAMB 

— 

Temperature  ambient  (F) 

*** 

•kleic 

TENG 

— 

Temperature  engine  (F) 

*** 

*** 

EMDOT 

— 

Engine  flow  rate  (Ib/s) 

*** 

*** 

FMDOT 

— 

Fuel  flow  rate  (Ib/s) 

*** 

*** 

PAMB 

— 

Pressure  ambient  (mm  Hg) 

*** 

*** 

TIG 

— 

Turbulence  intensity  inlet  (-) 

*** 

*** 

TIE 

— 

Turbulence  intensity  engine  (-) 

kkk 

*** 

XKFCTl 

- ; 

K-loss  factor  inlet  (-) 

*** 

XKFCT2 

— 

K-loss  factor  outlet  (-) 

*** 

XKFCTS 

-- 

K-loss  factor  chimney  (-) 

*** 

*** 

AMFl 

-- 

N2  mass  fraction  ambient  (-) 

kkk 

•kicit 

AMF2 

— 

02  mass  fraction  ambient  (-) 

*** 

*** 

AMF3 

— 

002  mass  fraction  ambient  (-) 

*** 

*** 

AMF4 

— 

H20  mass  fraction  ambient  (-) 

kkk 

kit* 

EMFl 

— 

N2  mass  fraction  engine  (-) 

*** 

*** 

EMF2 

— 

02  mass  fraction  engine  (-) 

*** 

kkk 

EMF3 

— 

C02  mass  fraction  engine  (-) 

*** 

kkk 

EMF4 

— 

H20  mass  fraction  engine  (-) 

*** 

kkk 

RPM 

— 

RPM  of  turboprop  (r/m) 

*** 

**★ 

SHP 

— 

Shaft  horse  power  of  engine  (hp) 

*** 

★  ★★ 

PCTK 

— 

%  of  engine  power  wasted  generating 

*** 

kkk 

turbulence  (%) 

*** 

kkk 

ICURVE 

— 

Selector  for  Ct/Cp  curve  in  ground  (1  or  2) 

kkk 

NRAMP 

— 

#  sweeps  over  which  to  ramp  in  KE-EP  prop 

*** 

*** 

sources  at  beginning  of  calculation  (1-20) 

*** 

kkk 

WARNING:  There  are  temperature  traps  set  in  GROUP  18.  At 

kkk 

kkk 

the  present  time  the  values  are  273  K  and  950  K. 

*** 

kkk 

*** 

**  4r  lA:  *  :«r  **  4r  ****  4r  4r  **  4r  **********  4r  ********  ****  4r  **********  ***  4r  ****  * 

* 

* 

*****: 

•:******:» 

:****! 

kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk' 

********* 

OTHER  VARIABLES  ************ 

kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

*** 

icick 

kkk 

NOTE: 

These  are  the  variables  used  to  define  this 

★  *  * 

*** 

oroblem. 

icicic 

*  *  * 

★  *  * 

kkk 

XCONOl 

Converts  in  to  m 

★  *  * 

kkk 

XCON02 

— 

Converts  F  to  R 

*  *  * 

kkk 

XCONO  3 

-- 

Converts  R  to  K 

*** 

*** 

XCON04 

-- 

Converts  BTU/ft/h/R  to  J/s/m/K 

-kUcit 

*** 

XCONO 5 

— 

Converts  lb  to  kg 

•k  ic  ic 

kkk 

XCONO 6 

— 

Converts  N/sq  m  to  in  H20 

kick 

*** 

XCONO 7 

— 

Converts  m/s  to  ft/s 

*** 

*** 

XCONO 8 

-- 

Converts  kg/cu  m  to  Ib/cu  ft 

*** 

*** 

XCONO 9 

-- 

Converts  in  Hg  to  N/sq  m 

*** 

*** 

XCONl 0 

— 

Spare 

*** 

*** 

XCONl 1 

— 

Spare 

*** 

*** 

PTRAP 

— 

Pressure  trap  (N/sq  m) 

*** 

*** 

RGAS 

-- 

Gas  constant  ( N-m/K/kgmol ) 

*** 

*** 

XMWl 

— 

Molecular  weight  N2  (kg/kgmol) 

*** 

*** 

XMW2 

— 

Molecular  weight  02  (kg/kgmol) 

*** 

*** 

XMW3 

— 

Molecular  weight  C02  (kg/kgmol) 

*** 

*** 

XMW4 

— 

Molecular  weight  H20  (kg/kgmol) 

*** 

*** 

EARSOR 

— 

Area  of  engine  plate  source  side  (sq  m) 

*** 

*** 

RHOAMB 

— 

Density  ambient  (kg/cu  m) 

*** 

*** 

RHOENG 

-- 

Density  engine  (kg/cu  m) 

*** 

*** 

ENTHA 

— 

Enthalpy  ambient  (J/kg) 

*** 

*** 

ENTHE 

— 

Enthalpy  engine  (J/kg> 

*** 

*** 

GAPIN 

— 

Gap  between  inlet  baffles  (m) 

*** 

*** 

GKE 

— 

Inlet  KE  (sq  m/sq  s) 

*** 

*** 

GEP 

— 

Inlet  EP  (sq  m/cu  s) 

*** 

*** 

EKE 

— 

Engine  KE  (sq  m/sq  s) 

*** 

*** 

EEP 

— 

Engine  EP  (sq  m/cu  s) 

*** 

If**************************************************'*!**************** 

* 


REAL { TAMB , RGAS , TENG ) 

REAL ( EARSOR , RHOAMB , RHOENG ) 

REAL ( AMFl , AMF2 , AMF3 , AMF4 , EMFl , EMF2 , EMF3 , EMF4 ) 

REAL ( ENTHA , ENTHE , XMWl , XMW2 , XMW3 , XMW4 , XMWA , XMWE ) 

REAL ( CONDI , THICKl , COND2 , TH1CK2 , PTRAP ) 

REAL ( XCONO 1 , XCONO  2 , XCONO  3 , XCON04 , XCON05 , XCON06 ) 

REAL ( XCONO  7 , XCONO  8 , XCONO  9 , XCONl 0 , XCONl 1 ) 

REAL ( EMDOT , FMDOT , PAMB ) 

REAL ( GAPIN , TIG , TIE , GKE , GEP , EKE , EEP ) 

REAL ( XKFCTl , XKFCT2 , XKFCT3 ) 

REAL ( RPM , SHP , PCTK ) 

INTEGER ( ICURVE , NRAMP ) 

* 

******************************************************************** 

*********  user  SECTION  ********* 

*******ifr********Tif****:lr******:lfe*************st***************i(t*******:*r* 

* 

COND1=0.022 

COND2=26.0 

THICKl =2.0 

THICK2-0.25 

TAMB=77.0 

TENG=1100.0 

EMDOT=32.4 

FMDOT=0.8333333 

PAMB=29 .92 

TIG=0.02 

TIE=0.15 

XKFCTl =1.0 

XKFCT2=1.0 

XKFCT3  =  1 . 0 

AMFl=0.76e3 

AMF2=0.2317 

AMF3=0.0 

AMF4=0.0 

EMF1=0.7479 

EMF2=0.1411 


EMF3>0.081 

KMF4-0.030 

PM»1021. 

-HP-4591. 

PCTK-5. 

CURVE- 2 
RAMP- 10 
* 

******************************************************************** 

* 

conversions 

XCONOl-0.0254;  RG( 31 ) -XCONOl 

CON02-459.67;  RG( 32 ) -XCON02 

.CON03-5. 0/9.0;  RG( 33 )-XCON03 

XCON04-1.73073;  RG( 34 ) -XCON04 

"CON05-0.45359;  RG( 35 ) -XCON05 

CON06-407 . 16/101325 . 0 ;  RG( 36 ) -XCON06 
XCON07-3.2802;  RG( 37 ) -XCON07 

VCON08-0. 062428;  RG( 38 ) -XCON08 

CON09-101325 . 0/29 . 92 ;  RG( 39 ) -XCON09 

CONDI -CONDI *XCON04 
:OND2-COND2*XCON04 
HICK1-THICK1*XCON01 
THICK2-THICK2*XCON01 
""AMB-  ( TAMB+XCON02  )  *XCON0  3  ' 

ENG- ( TENG+XCON02 ) *XCONO  3 
c;MDOT-EMDOT*XCONO  5 
FMDOT-PMDOT*XCONO 5 
G(702)-FMDOT 
. AMB-PAMB*XCON09 

density  info 
TRAP-0.05 
G(29)-PTRAP 
RGAS-0314.32 
PG(  1)-AMF1 
.G(  2)=AMF2 
txG(  3)-AMF3 
RG(  4)=AMF4 
G(  5)-EMFl 
G(  6)-EMF2 
RG(  7)-EMF3 
"G(  8)=EMF4 
G(  9)-TAMB 
RG(10)-TENG 

yMWl=28.1608;  RG(21)-XMW1 

MW2-31.9988;  RG(22)-XMW2 

..MW3-44.0100;  RG(23)-XMW3 

XMW4-18.0152;  RG(24)-XMW4 

G(25)=RGAS 

area  calculation  engine 
EARSOR-PI* (DENGI/2 . *XCON01 ) * ( DENGI/2 . *XCON01 ) 

’'G(802  )=EARSOR 

density  calculation 

XMWA-1 .0/ (AMF1/XMW1+AMF2/XMW2+AMF3/XMW3+AMF4/XMW4 ) 

XMWE-1 . 0/ (EMF1/XMW1+EMF2/XMW2+EMF3/XMW3+EMF4/XMW4 ) 

HOAMB=PAMB*XMWA/ (RGAS*TAMB ) 

..G(701  )=RHOAMB 

?.H0ENG=PAM3*XMWE/  ( RGAS*TENG ) 

run  satlit  for  enthalpy  calculation 


IG(1)=3 

SATRUN(NECL) 

other  stuff 
ENTHA»RG(11) 

ENTHE*RG(12) 

PRESS OsPAMB 

RH01=GRND 

DRH1DP=GRND 

turbulence  (assume  1  ft  gap  and  1  m/s  velocity) 

GAPIN=1.0*XCON01 

GKE«0 . 5* ( 1 . 0*TIG) **2 

GEP*0 . 164*GKE**1 .5/(0. 09*GAPIN) 

EKE*0 . 5* ( ( EMDOT/EARSOR/RHOENG) *TIE) **2 
EEP«0 . 164*EKE**1 .5/(0. 09*EARSOR**0 . 5 ) 

GROUP  10.  Inter-phase-transfer  processes  and  properties 

* 

******************************************************************** 

*********  INDEX  ********* 

******************************************************************** 
***  *** 

***  The  following  variables  are  used  as  an  index  to  define  *** 

***  the  extent  of  blockages  in  the  X,  Y,  &  Z  directions.  *** 

***  This  was  done  because  a  user  may  change  the  number  of  *** 

***  regions  in  each  direction.  The  user  will  then  make  the  *** 

***  appropriate  changes  in  this  section  and  then  no  further  *** 

***  changes  will  be  required  below  this  section.  The  *** 

***  nomenclature  for  the  variables  below  is  as  follows:  *** 

***  1.)  The  first  letter  represents  direction  (ie  I  for  X),  *** 

***  2.)  Middle  two  letters  represents  the  blockage  name,  & 

***  3.)  Last  letter  represents  first  or  last.  *** 

***  *** 

******************************************************************** 


INTEGER ( 
INTEGER ( 
INTEGER ( 
INTEGER ( 
INTEGER ( 
INTEGER ( 
INTEGER ( 
INTEGER ( 
INTEGER ( 
INTEGER ( 
INTEGER ( 
INTEGER ( 
INTEGER ( 
INTEGER ( 
INTEGER ( 
INTEGER ( 
INTEGER ( 
INTEGER ( 


I01P,I01L 

I02F,I02L 

I03F,I03L 

I04F,I04L 

I05F,I05L 

I06F,I06L 

I07F,I07L 

IPRF,IPRL 

IRGF,IRGL 

IEGF,IEGL 

IA1F,IA1L 

IA2F,IA2L 

IW1F,IW1L 

IW2F,IW2L 

IW3F,IW3L 

IW4F,IW4L 

IIN,KEP) 

lEPF.IEPL 


,J01F, 

,J02F, 

,J03F, 

,J04F, 

,J05F, 

,J06F, 

,J07F, 

,JPRF, 

,JRGF, 

,JEGF, 

,JA1F, 

,JA2F, 

,JW1F, 

,JW2F, 

,JW3F, 

,JW4F, 


JOIL, 

J02L, 

J03L, 

J04L, 

J05L, 

J06L, 

J07L, 

JPRL, 

JRGL, 

JEGL, 

JAIL, 

JA2L, 

JWIL, 

JW2L, 

JW3L, 

JW4L, 


KOIF, 

K02F, 

K03F, 

K04F, 

K05F, 

K06F, 

K07F, 

KPRF, 

KRGF, 

KEGF, 

KAIF, 

KA2F, 

KWIF, 

KW2F, 

KW3F, 

KW4F, 


KOIL) 

K02L) 

K03L) 

K04L) 

K05L) 

K06L) 

K07L) 

KPRL) 

KRGL) 

KEGL) 

KAIL) 

KA2L) 

KWIL) 

KW2L) 

KW3L) 

KW4L) 


,  JEPF, JEPL) 


orifice  housing  (lower  section) 


I01P=IXAF01; 

J01F»IYAF01; 

K01P-IZF03; 


IOlL=IXAL07 

JOlL=IYAL01 

K01L=IZL04 


orifice  housing  (mid-right  section) 


IC2F=IXAF01 ; 
J02F=IYAF02; 


IO2L=IXAL02 

JO2L=IYAL05 


K02F-IZF03; 

orifice  housing 
EO3F-IXAF07; 
J03F-IYAF02; 
K03F-IZF03; 

orifice  housing 
rO4F=IXAF01; 
J04F*IYAF06; 
KO4F*IZF03; 

orifice  housing 
I05F«IXAF01; 
JO5F«IYAP07; 
■;O5F-IZF03; 

orifice  housing 
I06F=IXAF01; 
T06F»IYAF08; 
SO6F=IZF03; 

orifice  housing 
T07F*IXAF05+IGAP/2; 
J07F*IYAF08; 
X07F=IZF03; 

prop 

EPRF=IXAF04; 
JPRF*IYAF03; 
XPRF*IZF06 ; 

reduction  gear 
IRGF«IXAF05-NXAD ; 
TRGP-IYAF04-NYAD ; 
iCRGF=IZF08; 

engine 

r EGF= IXAFO 5 -NXAD ; 
JEGF= I YAFO  4 -NY AD ; 
KEGF=IZF10; 

engine  plate 
IEPF=IEGF; 
JEPP=JEGF; 
<EP=IZF10+2 


KO2L-IZL04 
(mid-left  section) 
I03L-IXAL07 
JO3L-IYAL0S 
KO3L-IZL04 

(above  orifice-below  gap) 
I04L-IXAL07 
J04L-IYAL06 
KO4L-IZL04 
(beside  gap) 

I05L-IXAL01 
J05L«IYAL07 
KO5L-IZL04 
(top-right  section) 

I06L-IXAL04-IGAP/2 
J06L-IYAL08 
KO6L-IZL04 
(top-left  section) 
I07L-IXAL07 
J07L-IYAL08 
K07L*IZL04 


IPRL*IXAL05 

JPRL*IYAL04 

KPRL«IZL06 


IRGL=IXAL04+NXAD 
JRGL= I YALO 3+NYAD 
KRGL«IZL08 


IEGL=IXAL04+NXAD 
JEGL= lYALO  3+NYAD 
KEGL*IZL10 

IEPL=IEGL 

JEPL=JEGL 


IG(711)»KEP 

TG(712)*IEPP;IG(713)=IEPL 
EG ( 7 1 4 ) - JEPF ; IG ( 7 1 5 ) * JEPL 

augmenter  tube  (in  building) 
EA1F*IXCF03;  IA1L*IXCL04 

JA1F*IYCF03;  JA1L-IYCL04 

KA1F=IZF11;  KA1L=IZL16 

augmenter  tube  { in  chimney ) 
CA2F»IXDF02;  IA2L=IXDL03 

JA2F*IYDF02;  JA2L=IYDL03 

XA2F*IZF18;  KA2L*IZL19 


wall  (lower  section) 
TW1F=IXDF01;  IW1L=IXDL04 

JW1F=IYDF01;  JW1L=IYDL01 

.<W1F=IZF17;  KW1L»I2L18 

wall  (mid-right  section) 
CW2F*IXDF01;  IW2L=IXDL01 


JW2F»IYDF02;  JW2L=IYDL03 

KW2F=IZF17;  KW2L=IZL18 

wall  (mid-left  section) 

IW3F*IXDF04;  IW3L»IXDL04 

JW3F=IYDF02;  JW3L*IYDL03 

KW3F=IZF17;  KW3L*IZL18 

wall  (top  section) 

IW4F=IXDFC1;  IW4L=IXDL04 

JW4F=IYDF04;  JW4L*IYDL04 

KW4F=IZF17;  KW4L=IZL18 

GROUP  11.  Initialization  of  variable  or  porosity  fields 
orifice 

CONPOR( 0.0, CELL,  lOlF,  lOlL,  JOIF, -JOIL, -KOIF, -KOIL ) 
CONPOR( 0.0, CELL,  I02F,-I02L,  J02F,  J02L, -K02F, -K02L ) 
CONPOR( 0.0, CELL,  -I03F,  I03L,  J03F,  J03L,-K03F,-K03L) 
CONPOR( 0.0, CELL,  I04F,  I04L,-J04F,-J04L,-K04F,-K04L) 
CONPOR( 0.0, CELL,  I05F,-I05L,  J05F,  J05L, -K05F, -K05L ) 
CONPOR( 0.0, CELL,  I06F, -I06L , -J06F,  J06L,-K06F, -K06L) 
CONPOR( 0.0, CELL,  -I07F,  I07L,-J07F,  J07L,-K07F,-K07L) 

reduction  gear 

CONPOR (0.0, CELL ,  -IRGF , -IRGL , - JRGF , -JRGL , -KRGF, -KRGL ) 
engine 

CONPOR (0.0, SOUTH,  lEGF,  lEGL , - JEGF, -JEGF,  KEGF,  KEGL) 

CONPOR (0.0, NORTH,  lEGF,  lEGL, -JEGL,-JEGL,  KEGF,  KEGL) 

CONPOR (0.0, WEST,  -IEGF,-IEGF,  JEGF,  JEGL,  KEGF,  KEGL) 

CONPOR ( 0 . 0 , EAST ,  -IEGL,-IEGL,  JEGF,  JEGL,  KEGF,  KEGL) 

engine  plate 

CONPOR (0.0, HIGH,  IEPF,  IEPL,  JEPF,  JEPL,  KEP,  KEP ) 

augmenter  tube  (in  building) 

CONPOR (0.0, SOUTH,  lAlF,  lAlL, -JAIF, -JAIF,  KAIF,  KAIL) 

CONPOR (0.0, NORTH,  lAlF,  lAlL , -JAIL , -JAIL ,  KAIF,  KAIL) 

CONPOR (0.0, WEST,  -IA1F,-IA1F,  JAIF,  JAIL,  KAIF,  KAIL) 

CONPOR ( 0 . 0 , EAST ,  -IA1L,-IA1L,  JAIF,  JAIL,  KAIF,  KAIL) 

end  wall 

CONPOR ( 0 . 0 , CELL ,  IWIF,  IWIL,  JW1F,-JW1L,-KW1F,-KW1L) 

CONPOR ( 0 . 0 , CELL ,  IW2F,-IW2L,  JW2F,  JW2L, -KW2F, -KW2L ) 

CONPOR (0.0, CELL,  -IW3F,  IW3L,  JW3F,  JW3L,-KW3F,-KW3L) 

CONPOR (0.0, CELL,  IW4F,  IW4L,-JW4F,  JW4L,-KW4F, -KW4L ) 

augmenter  tube  ( in  chimney ) 

CONPOR (0.0, SOUTH,  IA2F,  IA2L , - JA2F , - JA2F,  KA2F,  KA2L) 

CONPOR (0.0, NORTH,  IA2F,  IA2L , - JA2L , -JA2L ,  KA2F,  KA2L) 

CONPOR (0.0, WEST,  -IA2F,-IA2F,  JA2F,  JA2L,  KA2F,  KA2L ) 

CONPOR (0.0, EAST,  -IA2L,-IA2L,  JA2F,  JA2L,  KA2F,  KA2L) 

init  all 

FIINIT(H1 )=ENTHA 
FI INIT ( TEMP ) =TAMB 
FIINIT ( RHOl ) =RHOAMB 
FIINIT(C3)=1.0 
FIINIT(W1 )=7 .0 
init  eng 

PATCH ( INITA , INIVAL , lEGF , lEGL , JEGF , JEGL , KEP+1 . KAIF- 1,1,1) 
INIT  (INITA, HI, 0.0,ENTHE) 


INIT  ( INITA, TEMP, 0.0, TENG) 

INIT  ( INITA, RH01,0.0,RHOENG) 

:NIT  (INITA, Cl, 0.0, 1.0) 

-NIT  (INITA, KE, 0.0, EKE) 

INIT  (INITA, EP,0.0,EEP) 

:NIT  ( INITA , W1 , 0 . 0 , EMDOT/EARSOR/RHOENG ) 

’ATCH ( INITB , INIVAL , lAlF , lAlL , JAIF , JAIL , KAIF , NZ , 1 , 1 ) 
INIT  (INITB, HI, 0.0,ENTHE) 

TNIT  (INITB, TEMP, 0.0, TENG) 

INIT  ( INITB , RHOl ,0.0, RHOENG ) 

INIT  (INITB, Cl, 0.0, 1.0) 

INIT  (INITB, KE, 0.0, EKE) 

INIT  (INITB, EP,0.0,EEP) 

’ATCH ( INITC , INIVAL , lAlF , lAlL , JAIF , JAIL , KAIF , NZ - 1 , 1 , 1 ) 
INIT  ( INITC , W1 , 0 . 0 , EMDOT/EARSOR/RHOENG ) 

(jROUP  12.  Convection  and  diffusion  adjustments 
GROUP  13.  Boundary  conditions  and  special  sources 
top  wall 

’AT(2J  ( XWALLO 1 ,  NWALL ,  1 ,  NX ,  NY ,  NY ,  I ZFO 1 ,  KWIF- 1 , 1 , 1 ) 

JOVAL ( XWALLOl , U1 , GRND2 , 0 . 0 ) 

COVAL ( XWALLO 1 , W1 , GRND2 ,0.0) 

:OVAL ( XWALLOl , KE , GRND2 , GRND2 ) 

:OVAL ( XWALLOl , EP , GRND2 , GRND2 ) 
bottom  wall 

’’ATCH ( XWALL02  , SWALL ,  1  ,NX ,  1 , 1 , 1 , KWlF-1 , 1 , 1 ) 

:OVAL  ( XWALL02 , U1 , GRND2 ,0.0) 

COVAL ( XWALL02 , W1 , GRND2 ,0.0) 

COVAL ( XWALLO  2 , KE , GRND2 , GRND2 ) 

:OVAL ( XWALL02 , EP , GRND2 , GRND2 ) 
side  to  bloc)c  wall 

PATCH(XWALL03 ,WWALL, 1 , 1 , 1 ,NY , 1 ,KW1F-1 , 1 , 1 ) 

ZOVkL  ( XWALL03 , VI ,GRND2 ,0.0) 

:OVAL (XWALLO 3 ,W1 ,GRND2 ,0.0) 

COVAL ( XWALLO  3 , KE , GRND2 , GRND2 ) 

COVAL ( XWALLO  3 , EP , GRND2 , GRND2 ) 

’ATCH ( XWALL04 , EWALL , NX , NX , 1 , NY , 1 , KWlF-1 , 1 , 1 ) 

COVAL ( XWALL04 , VI , GRND2 ,0.0) 

COVAL ( XWALL04 , W1 , GRND2 ,0.0) 

:OVAL ( XWALL04 , KE , GRND2 , GRND2 ) 

:OVAL ( XWALLO 4 , EP , GRND2 , GRND2 ) 
chimney  wall 

•’ATCH  ( XWALLO  5  ,  NWALL ,  1 ,  NX ,  NY ,  NY  ,  KA2L+1 ,  NZ ,  1 , 1 ) 

:OVAL  ( XWALL05  ,  U1 ,  GRND2 , 0 . 0  ) 

COVAL ( XWALL05 , W1 , GRND2 ,0.0) 

COVAL ( XWALLO  5 , KE , GRND2 , GRND2 ) 

:OVAL ( XWALLO 5 , EP , GRND2 , GRND2 ) 

CATCH(XWALL06 ,SWALL,1 ,NX, 1 , 1 ,KW1L+1 ,NZ , 1 , 1 ) 

COVAL ( XWALL06 , U1 , GRND2 ,0.0) 

:OVAL ( XWALLO  6 , W1 , GRND2 ,0.0) 

:OVAL ( XWALLO 6 , KE , GRND2 , GRND2 ) 

COVAL ( XWALLO 6 , EP , GRND2 , GRND2 ) 

’’ATCH (XWALLO 7  ,WWALL  ,  1 , 1 , 1  ,NY  ,  KWlL+1  ,NZ  ,1,1) 

ICVAL { XWALLO 7 , VI , GRND2 ,0.0) 

COVAL ( XWALLO 7 , W1 , GRND2 ,0.0) 

COVAL ( XWALL07 , KE , GRND2 , GRND2 ) 

:OVAL ( XWALLO  7 , EP , GRND2 , GRND2 ) 

.’ATCH  ( XWALL08  ,  EWALL , NX ,  NX ,  1 ,  NY  ,  KWlL+1 , NZ  ,  1 , 1 ) 

COVAL ( XWALLO 8 , VI , GRND2 ,0.0) 

:OVAL ( XWALLO  8 , W1 , GRND2 ,0.0) 


COVAL ( XWALLO  8 , KE , GRND2 , GRND2 ) 

COVAL ( XWALLO  8 , EP , GRND2 , GRND2 ) 

front  opening 

PATCH(XOPENl ,LOW, 1 ,NX, 1 ,NY, 1 , 1 . 1 , 1 ) 

COVAL (XOPENl , PI ,GRND7 ,0.0) 

COVAL ( XOPENl , W1 , ONLYMS , GRND7 ) 

COVAL { XOPENl , HI , ONLYMS , ENTHA ) 

COVAL ( XOPENl , KE , ONLYMS^  GKE ) 

COVAL ( XOPENl , EP , ONLYMS , GEP ) 

COVAL ( XOPENl , UCRT , ONLYMS , XKFCTl ) 

back  opening 

PATCH ( XOPEN2A , HIGH , IWIF . IWIL , JW3  F , JWIL , KWIF- 1 , KWl F- 1 , 1 , 1 ) 
COVAL ( XOPEN2A , PI , GRND7 ,0.0) 

COVAL ( XOPEN2A , W1 , ONLYMS , SAME ) 

COVAL ( XOPEN2A , HI , ONLYMS , ENTHA ) 

COVAL ( XOPEN2A , UCRT , ONLYMS , XKFCT2 ) 

PATCH ( XOPEN2B , HIGH , IW2F , IW2L , JW2F , JW2L , KWIF- 1 , KWIF- 1,1,1) 
COVAL ( XOPEN2B , PI , GRND7 ,0.0) 

COVAL ( XOPEN2B , W1 , ONLYMS , SAME ) 

COVAL ( XOPEN2B , HI , ONLYMS , ENTHA ) 

COVAL ( XOPEN2B , UCRT , ONLYMS , XKFCT2 ) 

PATCH ( XOPEN2C , HIGH , IW3F , IW3L , JW3F , JW3L , KWlF-1 , KWlF-1 ,1,1) 
COVAL ( XOPEN2C , PI , GRND7 , 0 . 0 ) 

COVAL ( XOPEN2C , W1 , ONLYMS , SAME ) 

COVAL ( XOPEN2  C , HI , ONLYMS , ENTHA ) 

COVAL ( XOPEN2C , UCRT , ONLYMS , XKFCT2 ) 

PATCH ( XOPEN2D , HIGH , IW4F , IW4L , JW4F , JW4L , KWIF- 1 , KWIF- 1,1,1) 
COVAL ( XOPEN2D , PI , GRND7 ,0.0) 

COVAL ( XOPEN2D , W1 , ONLYMS , SAME ) 

COVAL ( XOPEN2D , HI , ONLYMS , ENTHA ) 

COVAL ( XOPEN2D , UCRT , ONLYMS , XKFCT2 ) 

chimney  exhaust 

PATCH(XOPEN3,HIGH,l,NX,l,NY,N2,NZ,l,l) 

COVAL ( XOPEN3 , PI , GRND7 ,0.0) 

COVAL ( XOPEN3 , W1 , ONLYMS , SAME ) 

COVAL { XOPEN  3 , HI , ONLYMS , ENTHA ) 

COVAL ( XOPEN 3 , UCRT , ONLYMS , XKFCT  3 ) 

engine  mdot  sink 

PATCH  ( XENGIN ,  Hlf .*■  ,  lEGL ,  JEGF ,  JEGL ,  KEP ,  KEP  ,1,1) 

COVAL ( XENGIN , PI , FIXFLO , GRNDIO ) 

COVAL ( XENGIN , HI , ONLYMS , SAME ) 

RG ( 8  04 )  =  ( EMDOT-FMDOT ) /EARSOR 

engine  mdot  source 

PATCH ( XENGOUT , LOW , lEGF , lEGL , JEGF , JEGL , KEP+1 , KEP+ 1,1,1) 
COVAL ( XENGOUT , PI , FIXFLU , GRNDl 0 ) 

COVAL ( XENGOUT , W1 , ONLYMS , EMDOT/EARSOR/RHOENG ) 

COVAL ( XENGOUT , HI , ONLYMS , ENTHE ) 

COVAL ( XENGOUT , Cl , ONLYMS ,1.0) 

COVAL ( XENGOUT , KE , ONLYMS , EKE ) 

COVAL ( XENGOUT , EP , ONLYMS , EEP ) 

RG( 005 ) =EMDOT/ EARSOR 

Drop 

PATCH (Z PROP, PHASEM, I PRF  ,IPRL,JPRF  , JPRL , KPRF , KPRF , 1  , 1  ) 
COVAL ( ZPRO?,Wl , FIXFLU, GRND9 ) 

PATCH (XPROP,  LOW  , IPRF-1 , IPRL , JPRF  , JPRL , KPRF , KPRF , 1 , 1 ) 
COVAL ( XPROP , U1 , FIXFLU , GRND9 ) 

PATCH (YPROP,  LOW  ,IPRF  , IPRL , JPRF- 1 , JPRL , KPRF, KPRF, 1 , 1 ) 
COVAL ( YPROP , VI , FIXFLU , GRND9 ) 

PATCH (KFROP,  LOW  .IPRF  , IPRL, JPRF  , JPRL , KPRF , KPRF , 1 , 1  ) 
COVAL ( KPROP . KE , FIXFLU , GRND9 ) 


COVAL ( KPROP , EP , FIXFLU , GRND9 ) 

RG(830)=RPM;RG(831)=SHP 

:G(832)*PCTK 

iG ( 8 7 5 ) - ICURVE ; IG ( 8 7 6 ) =NRAMP 

heat  transfer  augmenter  tube  (in  building) 

>ATCH ( HEATTRIE , EWALL , lAlF- 1 , lAlF , JAIF , JAIL , KAIF , KAIL ,1,1) 

:OVAL ( HEATTRIE , HI , GRND8 , GRND8 ) ; COVAL ( HEATTRIE , UCRT , CONDI , THICKl ) 
PATCH ( HEATTRIW , WWALL , lAlL , lAl L+ 1 , JAIF , JAIL , KAIF , KAIL ,1,1) 

COVAL ( HEATTRIW , HI , GRND8 , GRND8 ) ; COVAL ( HEATTRIW , UCRT , CONDI , THICKl ) 
’ATCH ( HEATTRIN , NWALL , lAlF , lAlL , JAlF-1 , JAIF , KAIF , KAIL ,1,1) 

COVAL ( HEATTRIN , HI , GRND8 , GRND8 ) ; COVAL ( HEATTRIN , UCRT , CONDI , THICKl ) 
PATCH ( HEATTRIS , SWALL , lAlF , lAlL , JAIL , JAlL+1 , KAIF , KAIL ,1,1) 

:OVAL ( HEATTRIS , HI , GRND8 , GRND8 ) ; COVAL ( HEATTRIS , UCRT , CONDI , THICKl ) 
heat  transfer  augmenter  tube  (in  chimney) 

PATCH ( HEATTR2E , EWALL , IA2F- 1 , IA2F , JA2F , JA2L ,  KA2F , KA2L ,1,1) 

lOVAL  ( HEATTR2E ,  HI ,  GRND8  ,  GRND8  )  ;  COVAL  ( HEATTR2E ,  UCRT ,  COND2  ,  THICK 2  ) 

>ATCH ( HEATTR2W , WWALL , IA2L , I A2L+ 1 , JA2F , JA2L , KA2F , KA2L ,1,1) 

COVAL  ( HEATTR2W ,  HI ,  GRND8  ,  GRND8  )  ;  COVAL  ( HEATTR2W ,  UCRT ,  COND2 ,  THICK2  ) 
®ATCH ( HEATTR2N , NWALL , IA2F , IA2L , JA2F- 1 , JA2F , KA2F , KA2L ,1,1) 

:OVAL  ( HEATTR2N ,  HI ,  GRND8  ,  GRND8  )  ;  COVAL  ( HEATTR2N ,  UCRT ,  COND2  ,  THICK2  ) 
PATCH ( HEATTR2S , SWALL , IA2F , IA2L , JA2L , JA2L+1 , KA2F , KA2L , 1 , 1 ) 

COVAL ( HEATTR2S , HI , GRND8 , GRND8 ) ; COVAL ( HEATTR2S , UCRT , COND2 , THICK  2 ) 


GROUP  14.  Downstream  pressure  for  PARAB=.TRUE. 

PSWEEP=1 

■,SWEEP=2500 

* 

★*********************************:★***★*****★*********************** 

*********  USER  CONTROLS  ********* 

******************************************************************** 


*** 
*** 
*** 
*** 
*** 
*** 
*** 
*  *  * 
*** 
*** 
*** 
*** 
*** 
*** 


The  following  integer  arrays  are  described  below. 


IG(901)  —  Frequency  of  ground  printout  on  wall  heat 

transfer  &  convergence. 

IG(902)  —  Frequency  of  restart  files  and  English  unit 

calculation  (NOTE:  Overwrites  previous). 
IG(999)  —  Set  to  1  to  stop  run  on  first  sweep. 

IG(  38)  —  Set  to  1  for  first  set  of  spot  value  info. 

IG(  39)  —  Set  to  1  for  second  set  of  spot  value  info. 

IG(  40)  —  Set  to  1  for  third  set  of  spot  value  info. 

IG(  41)  —  Set  to  1  for  additional  heat  transfer  info. 


*** 
*  *  * 
★  *  * 
★  *  * 
ic  'fcfe 
★  *  * 

*  *  * 

★  ★  * 

*  ★  ifc 

*  ★  * 


Termination  of  sweeps 
Termination  of  iterations 


icidtiticicicikfcicieititicidticicitifiticideicicic  *,★ 

TG(901 )=50 
:G(902)=100 
xG(999)=0 

GROUP  15 
GROUP  16 
.ITER(P1  )  =  30 
ENDIT(P1 )=1 .OE-3 
':NDIT(H1  )=1  .OE-2 
:ESREF(P1)  =  1.0E-8 
RESREF(U1 )=1 .OE-8 
RESREF(V1 )=1 .OE-8 
:ESREF(W1)»1.0E-8 
*iESREF(Hl  )*1  .OE-8 
RESREF(C1 )=1 .OE-8 
:ESREF(KE)=1 .OE-8 


RESREF(EP)=1.0E-8 

GROUP  17.  Under-relaxation  devices 
RELAX ( PI , LINRLX ,0.10) 

RELAX ( KE , LINRLX ,0.10) 

RELAX ( EP , LINRLX ,0.10) 

RELAX ( U1 , FALSDT ,0.001) 

RELAX (VI, FALSDT ,0.001) 

RELAX ( W1 , FALSDT ,0.001) 

RELAX ( HI , FALSDT ,0.005) 

RELAX ( Cl , FALSDT ,0.005) 

GROUP  18.  Limits  on  variables  or  increments  to  them 
VARMAX ( Cl ) = 1 . 0  0 ; VARMIN (C1)*1.0E-10 
VARMAX ( ENUT ) =10000000 . *ENUL 
VARMAX ( TEMP ) =950 . 0 ; VARMIN ( TEMP ) =27  3 . 0 

GROUP  19.  Data  communicated  by  satellite  to  GROUND 

GROUP  20.  Preliminary  print-out 

GROUP  21 .  Print -out  of  variables 
OUTPUT ( PI, Y,Y,N,y,Y,Y) 

OUTPUT (U1,Y,N,N,Y,Y,Y) 

OUTPUT ( VI, Y,N,N,Y,Y,Y) 

OUTPUT (W1,Y,N,N,Y,Y,Y) 

OUTPUT (KE,N,N,N,Y,Y,Y) 

OUTPUT {EP,N,N,N,Y,Y,Y) 

OUTPUT (HI, N,N,N,Y,Y,Y) 

OUTPUT ( Cl, N,N,N,Y,Y,Y) 

OUTPUT (C3,N,N,N,N,N,N) 

OUTPUT (TEMP, Y,N,N,N,N,N) 

OUTPUT ( CP, N,N,N,N,N,N) 

OUTPUT (C6,N,N,N,N,N,N) 

OUTPUT (C7,N,N,N,N,N,N) 

OUTPUT (U2,N,N,N,N,N,N) 

OUTPUT (V2,N,N,N,N,N,N) 

OUTPUT (W2,N,N,N,N,N,N) 

OUTPUT (PH20,N,N,N,N,N,N) 

OUTPUT (TFAR,N,N,N,N,N,N) 

OUTPUT (RHOE,N,N,N,N,N,N) 

OUTPUT ( SPAR, N,N,N,N,N,N) 

OUTPUT (RH01,Y,N,N,N,N,N) 

OUTPUT (UCRT,N,N,N,N,N,N) 

OUTPUT (VCRT,N,N,N,N,N,N) 

OUTPUT (WCRT,N,N,N,N,N,N) 

GROUP  22.  Spot-value  print-out 
IXMON  =18;IYMON  =18;IZMON  =  3 
IXM0N1*28 ; IYM0N1=28 ; IZMONl=12 
IXMON2=  6;IYMON2=  6;IZMON2=19 
IXMON3=18 ; IYMON3=18 ; IZMON3=19 
IXM0N4  =  13; I YMON4  =  13; I ZMON4  =37 
IXMON5=l 3 ; IYMON5=l 3 ; IZMON5=44 
IXMON6 =18; I YMON6  =  1 8 ; I ZMON6 =46 
IXMON7  =  11; I YMON7  =  1 1 ; I ZMON7  =  58 
IXMON8=ll ; IYMON8=26 ; IZMON8=70 
IXMON9=19 ; IYMON9=16 ; IZMON9=72 
IG( 11 ) =IXMONl ; IG( 12 ) =IYMONl ; IG( 13 ) =IZMONl 
IG ( 1 4 ) = IXM0N2 ; IG ( 1 5 ) = I YMON2 ; IG ( 1 6 ) = IZMON2 
IG(17)=IXMON3;IG(18)=IYMON3;IG(19)=IZMON3 
IG( 20 ) =IXMON4 ; IG( 21 ) =IYMON4 ; IG( 22 ) =IZMON4 
IG(23)=IXMON5;IG(24 )=IYMON5;IG(25)=IZMON5 
IG( 26 ) =IXMON6 ; IG( 27 ) =IYMON6 ; IG( 28 ) =IZMON6 
IG(29 )=IXMON7 ;IG( 30 ) =IYMON7 ; IG( 31 )=IZMON7 
IG( 32 )=IXMON8;IG( 3 3 ) =IYMON8 ; IG( 34 )=IZMON8 


xG(35)*IXMON9;IG( 36 )=IYM0N9;IG( 37)=I2MON9 
IG{ 38)*1 
;G( 39)=1 
;G(40)=0 
IG(41)=0 

GROUP  23.  Field  print-out  and  plot  control 
:2PR=T; IXPRF=19 ; IXPRL=19 
x’STSWP= 5 ;  NPRMON=  5 

NPRINT=LSWEEP ;  IPLTL*LSWEEP ;  ITABL=3 

iBSIZ=.8;  0RSIZ=.8;  NUMCLS=10 

TPLT=10 

GROUP  24 .  Dumps  for  restarts 
RESTRT ( ALL ) ; NAMFI = INXS 
5T0P 


APPENDIX  C 


J  THIS  IS  THE  MAIN  PROGRAM  OF  THE  SATELLITE 
PROGRAM  MAIN 

:  FILE  NAME  satlit.f  09/27/87 

(C)  COPYRIGHT  1984,  LAST  REVISION  1987. 

CONCENTRATION  HEAT  AND  MOMENTUM  LTD.  ALL  RIGHTS  RESERVED. 

This  subroutine  and  the  remainder  of  the  PHOENICS  code  are 
proprietary  software  owned  by  Concentration  Heat  and  Momentum 
Limited,  40  High  Street,  Wimbledon,  London  SW19  5AU,  England. 

LOGICAL  TALK, RUN, LVAL 
EXTERNAL  WAYOUT 

1  Set  dimensions  of  blank-COMMON  arrays  here.  WARNING:  the 
corresponding  blank-COMMON  arrays  in  subroutine  SATLIT  must 
have  the  same  dimensions. 

PARAMETER  (NXFD=1000 ,NYFD=1000 ,NZFD=1000 ,NTFD=10000 ) 

PARAMETER  (NTCVD=25000 ,NBFCD=500000 ) 

COMMON  TCVDA ( NTCVD ) , XFRAC ( NXFD ) , YFRAC ( NYFD ) , ZFRAC ( NZFD ) , 

ITFRAC ( NTFD ) , BFCS ( NBFCD ) 

2  Set  dimensions  of  PATCH-name  array  and  the  instruction-stack 
array  here.  The  dimension  of  the  array  NLN  must  be  the  same 
as  that  of  STACK.  WARNING:  the  array  NAMPAT  in  the  MAIN 
program  of  EARTH  (see  GROUND)  must  have  the  same  dimension. 
These  are  specified  by  the  parameters  npatd  and  nld,  set  below. 
PARAMETER  (NPATD=1000 ,NLD=2000 ) 

COMMON/NPAT/NAMPAT ( NPATD ) /NSTCK/STACK ( NLD ) /LINENO/NLN ( NLD ) 
CHARACTER  NAMPAT*8 , STACK*72 
COMMON/CNFG/CNFIG 
CHARACTER  CNFIG*48 

3  Set  dimension  of  run  array  to  MAXRUN. 

PARAMETER  (NRUND=500) 

COMMON/RUNS/RUN ( NRUND ) 

4  Set  dimensions  of  data-for-GROUND  arrays  here.  WARNING:  the 
corresponding  arrays  in  the  MAIN  program  of  EARTH  (see 
GROUND)  must  have  the  same  dimensions. 

PARAMETER  ( NLGD= 1000,NIGD=1000, NRGD= 10000, NCGD= 1000) 
COMMON/LGRND/LG  ( NLGD )  /IGRND/IG  ( NIGD )  /RGRND/RG(  NRGD ) 
COMMON/CGRND/CG ( NCGD ) 

LOGICAL  LG 
CHARACTER *4  CG 

5  Set  dimensions  of  data-for-GREXl  arrays  here.  WARNING:  the 
corresponding  arrays  in  the  MAIN  program  of  EARTH  (see 
GROUND)  must  have  the  same  dimensions. 

COMMON/LSG/LSGD( 20 ) /ISG/ISGD( 20 ) /RSG/RSGD( 100 ) /CSG/CSGD( 10 ) 
LOGICAL  LSGD 
CHARACTER* 4  CSGD 

6  Set  dimensions  for  user-declared  PIL  variables  here. 

PARAMETER  (NIPD=1000 ,NRPD=1000 ) 

COMMON/NIDEC/INDEC ( NIPD ) / IDEC/INVAL ( NIPD ) 

COMMON/NRDEC/REDEC ( NRPD ) /RDEC/REVAL ( NRPD ) 

CHARACTER  REDEC*6 , INDEC*6 

7  For  more  than  the  default  of  3C  variables  increase  nvd . 

WARNING:  the  corresponding  parameter  nvd  in  the  MAIN  program  of 


C  EARTH  (see  ground. f)  must  be  the  same. 

PARAMETER  (NVD=80) 

COMMON/LDBl/DBGPHI ( NVD ) /IDAl/ITERMS ( NVD ) /IDA2/LITER ( NVD ) 

1  / IDA3  / 1 ORCVF  ( NVD )  / IDA4 / 1 ORCVL  ( NVD )  / IDA5 / ISLN  ( NVD )  / IDA6  / IPRN  ( NVD ) 
1/HDAl/NAME  ( NVD )  /RDAl/DTFALS  ( NVD )  /RDA2/RESREF  ( NVD ) 

1/RDA3 /PRNDTL  ( NVD )  /RDA4/PRT  ( NVD )  /RDA5/ENDIT  ( NVD )  /RDA6 / VARMIN  ( NVD ) 
1 /RDA7 /VARMAX ( NVD ) /RDA8/FIINIT ( NVD ) /RDA9 /PHINT ( NVD ) 

1 /RDAl 0 /CINT ( NVD ) /RDAl 1 /EX ( NVD ) 

1/IPIP1/IP1(NVD)/HPIP2/IHP2(NVD)/RPIP1/RVAL(NVD) 

1/LPIP1/LVAL(NVD) 

C 

C  8  Set  dimension  indicators  to  correspond  with  above  dimensions. 
CALL  SUB4  ( MAXTCV ,  NTCVD ,  MAXRUN ,  NRUND ,  NBFC ,  NBFCD ,  NUMPHI ,  NVD ) 

CALL  SUB4  ( NLG ,  NLGD ,  NIG ,  NIGD ,  NRG ,  NRGD ,  NCG ,  NCGD ) 

CALL  SUB4 (NLSG, 20,NISG, 20 ,NRSG, 100 ,NCSG, 10 ) 

CALL  SUB4 ( NIPIL , NIPD , NRPIL , NRPD , NPNAM , NPATD , NSTACK , NLD ) 

CALL  SUB4  ( NXFR ,  NXFD ,  NYFR ,  NYFD ,  NZFR ,  NZFD ,  NTFR ,  NTFD ) 

C 

C  9  Logical  unit  numbers  &  file  names. 

CALL  CNFGZZ(l) 

CALL  OPENFL(6) 

CALL  OPENFL(5) 

CALL  READQl ( TALK , RUN , MAXRUN ) 

ry 

CALL  SMAINl  ( TALK  ,  MAXTCV ,  MAXRUN ,  NBFC ,  NUMPHI ,  NLG ,  NIG ,  NRG ,  NCG , 

INLSG ,  NISG ,  NRSG ,  NCSG ,  NIPIL ,  NRPIL ,  NPNAM ,  NSTACK ,  NXFR ,  NYFR ,  NZFR , 
INTFR) 

CALL  WAyOUT(O) 

END 

Q************************************************************ 

SUBROUTINE  SAT 

C 

INCLUDE  'satear' 

INCLUDE  'satloc' 

C -  Call  satellite  used  in  BFC  test-battery. 

CALL  BFCTST 

C -  the  users  USERST  subroutine. 

IF{NAMSAT.EQ. 'USER' )  CALL  USERST 

C -  Call  the  SATLIT  subroutine. 

CALL  SATLIT 

RETURN 

END 

0************************************************************ 
SUBROUTINE  BFCTST 
C 

INCLUDE  'satear' 

INCLUDE  'satloc' 

PARAMETER  (NLGD=1000,NIGD=1000, NRGD= 10000, NCGD= 1000) 
COMMON/LGRND/LG  ( NLGD )  /IGRND/IG  ( NIGD )  /RGRND/RG  ( NRGD ) 
COMMON/CGRND/CG ( NCGD ) 

LOGICAL  LG 

C -  Special  sequence  for  BFC  test  battery  :  IG(1)=28 

IF( .NOT. (BFC.AND.IG( 1 ) . EQ . 28 . AND . IGR . EQ . 1 ) )  RETURN 
L1=MIN0(IG(2) ,NZ) 

IF(Ll.LT.l)  GO  TO  2 
DO  1  IZ=1,L1 

1  CALL  XCYIZ(IZ,LG(10) ) 

2  L2=MAX0{1,IG( 3) ) 


3 


IF(L2.GT.NZ)  RETURN 
DO  3  IZ»L2,NZ 
CALL  XCYIZ(IZ,LG(10) ) 

RETURN 
END 

SUBROUTINE  USERST 

CALL  WRIT40( 'DUMMY  SUBROUTINE  USERST  CALLED.  ') 

RETURN 
END 

;********************************************************★*** 
SUBROUTINE  SATLIT 
C 

INCLUDE  'satear' 

INCLUDE  'satloc' 

CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  USER  SECTION  STARTS: 

"I 

;  1  Set  dimensions  of  blank-COMMON  arrays  here  to  the 

C  dimensions  of  the  same  arrays  In  the  MAIN  program  of  the 

c  satellite. 

PARAMETER  (NXFD=1000  ,NyFD=1000  ,NZFD*1000  ,NTFD=10000  ) 

PARAMETER  (NTCVD=25000 ,NBFCD=500000 ) 

COMMON  TCVDA ( NTCVD ) , XFRAC ( NXFD ) , YFRAC ( NYFD ) , ZFRAC ( NZFD ) , 

ITFRAC ( NTFD ) , BFCS ( NBFCD ) 

t 

C  2  Set  dimensions  of  data-for-GROUND  arrays  here.  WARNING:  the 
corresponding  arrays  In  the  MAIN  program  of  the 
;  satellite  program  and  the  EARTH  program  must  have  the  same 

c  dimensions. 

PARAMETER  ( NLGDe 1000,NIGD=1000, NRGD= 10000, NCGD* 1000) 
COMMON/LGRND/LG  ( NLGD )  /IGRND/IG  ( NIGD )  /RGRND/RG  ( NRGD ) 
COMMON/CGRND/CG ( NCGD ) 

LOGICAL  LG 
CHARACTER* 4  CG 

« 

C  3  Introduce  SATLIT-only  commons,  arrays,  equivalences. 

DIMENSION  SC(4) ,IX(16) ,XL(16) ,XP(16) ,IY(16) ,YL(16) ,YP(16) , 

&  NZC(26) ,ZL(26) , ZP ( 26 ) , IZT ( 26 ) , IZFl ( 26 ) ,IZF2(26) , 

6.  XAS(2500)  ,YAS(2500)  ,ZAS(2500)  ,XAS1(2500)  ,YAS1(2500)  , 

&  ZAS1(2500) ,XAS2(2500) ,YAS2( 2500) ,ZAS2( 2500) ,ZASL(100) 

C  4  User  places  his  data  statements  here. 

GO  TO  (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21, 
122,23,24) ,IGR 

: - GROUP  1.  Run  title  and  other  preliminaries 

1  CONTINUE 

WRITE ( 6 , * ) '  IN  SATLIT  ' 

RETURN 

C -  GROUP  2.  Transience;  time-step  specification 

2  CONTINUE 
RETURN 

C 

r -  GROUP  3.  X-direction  grid  specification 

3  CONTINUE 
RETURN 

r* 

-  GROUP  4.  Y-direction  grid  specification 


4  CONTINUE 
RETURN 

C 

C -  GROUP  5.  Z-direction  grid  specification 

5  CONTINUE 
C 

IF(IG(1 ) .GE.2)  RETURN 

IF(IG(1) .EQ.O)  WRITE(6,*)'  CREATING  GRID  INPUT  FILES' 

IF(IG(1) .GE.l)  WRITE(6,*)'  CALCULATING  INLET  LOCATION' 

C 

c*********************************************************************** 

C-pd - This  is  the  second  option  for  exit  of  the  engine.  There  will — 

C -  will  be  either  2  or  3  cross  sections  written  here  depending - 

C on  the  location  exit.  It  will  be  2  if  it  ends  before  the - 

C -  augmenter  tube  or  if  it  ends  at  the  start  of  the  tappered - 

C -  section  or  at  the  start  of  straight  section.  It  will  be  3 - 

C -  if  it  falls  in  the  tappered  section  or  after  the  start  of - 

C -  the  straight  section. - 

C  tl 

DO  561  1=1,5 
C 

NI=14 
IX(1  )=1 

CALL  SETIV(IX,IG,100,1,NI) 

C 

XCENA=RG(41) 

YCENA»RG(42) 

XCENB=RG(43) 

YCENB=RG(44) 

RADl=RG(52)/2. 

DXI=(RADl*RADl/2, )**0.5 
RAD2=RG(50)/2. 

IF(I.EQ.3)  RAD2-RG(51)/2. 

DXII=(RAD2*RAD2/2. )**0.5 
IFST=IG(117) 

JFST=IG(137) 

C 

C-pd - Do  trig - 

C 

DXI02=DXI+ ( YCENB-YCENA) 

TETT02*ASIN{DXI02/RAD2)*1 80. /3. 141592654 
DXI 1 6 =DXI -( YCENB-YCENA ) 

TETT16=ASIN( DXI16/RAD2) *180. /3. 141592654 
DXI 0  4-DXI+ ( XCENB-XCENA ) 

TETT04=ASIN(DXI04/RAD2) *180. /3. 141592654 
DXI 0 6 «DXI -( XCENB-XCENA ) 

TETT06=ASIN (DXI06/RAD2)*! 80. /3. 141592654 
DXI08*DXI+ { YCENB-YCENA ) 

TETT08=ASIN(DXI08/RAD2)*180./3. 141592654 
DXI 1 0=DXI- { YCENB-YCENA ) 

TETT10=ASIN(DXI10/RAD2)*180./3. 141592654 
DXI12=DXI- (XCENB-XCENA) 

TETT12=ASIN{DXI12/RAD2 ) *180 ./3 . 141592654 
DXI 1 4 = DXI + ( XCENB- XCENA ) 

TETT14=ASIN (DXI14/RAD2)* 180 ./ 3. 141592654 
C 

XL(1  )=0.0 

CALL  SETCV'XL,RG, 100, 1 ,NI 1 
XL( IFST^l ) =XCSNB-DXI 
XL ( IFST+  3 ) =XCENB+DXI 


XL(IFST  )-XCENA-DXII 
XL ( IFST+4 ) -XCENA+DXII 

CALL  SETRV(XP,RG,120,2,NI) 


IY{1  )*1 

CALL  SETIV(iy,IG,120,l.NI) 

C 

YL(1  )«0.0 

CALL  SETRV(YL,RG,140,1,NI) 

YL ( JFST+ 1 ) = YCENB-DXI 
YL ( JFST+  3 ) * YCENB+DXI 
YL(JFST  )«YCENA-DXII 
YL ( JFST+4 ) =YCENA+DXII 
C 

CALL  SETRV(YP,RG,160,2,NI) 

LU*60+I 
CG(LU)»'CS  ' 

I10*LU/10 

I1=LU-I10*10 

WRITE(CG(LU)  (3:3)  ,  '  (II)  '  )  no  ' 

WRITE(CG(LU) (4:4) , ' (II) ' )  n 

OPEN  ( LU , FILE=CG ( LU ) , FORM= ' FORMATTED ' , STATUS= ' UNKNOWN ' ) 
IF(RG(LU+10) .NE.0.0)  XL( 1 ) =RG(LU+10 ) 

IRX=IG(42) 

IRY=IG(43) 

CALL  WRTSQ(LU,NX,NY,IRX,IRY,IX,IY,XL,YL,XP,YP) 
IF(I.EQ.l)  THEN 

w-pd - Overwrite  line  info  with  box  data - 

C 

IFSR*IG(117)+1 

JFSR=IG(137)+1 

IMID*IFSR+1 

JMID*JFSR+1 

IAD=IG(50) 

JAD=IG(51) 

RAD3=RG(53)/2. 


& 

fit 

fit 

fit 

& 

fit 

fit 

& 


WRITE ( LU , * ) 

WRITE (LU, 102 ) IX( IMID) -lAD, IX(IMID) ,IY(JMID)-JAD,IY(JMID)-JAD 
XCENB-RAD3 , YCENB-RAD3 , XCENB , YCENB-RAD3 , 1 . 0 
WRITE  ( LU ,  1 0 2  )  IX  ( IMID )  ,  IX  ( IMID ) +IAD ,  I Y  ( JMID )  -  JAD ,  lY  ( JMID )  - JAD , 
XCENB , YCENB-RAD3 , XCENB+RAD3 , YCENB-RAD3 , 1 . 0 
WRITE ( LU , 1 0 2 ) IX ( IMID ) - 1 AD , IX ( IMID ) , I Y ( JMID ) + JAD , I Y ( JMID ) + JAD , 

XCENB-RAD3 , YCENB+RAD3 , XCENB , YCENB+RAD3 ,1.0 
WRITE ( LU , 1 0  2 ) IX ( IMID ) , IX ( IMID ) +IAD , I Y ( JMID ) + JAD , I Y ( JMID ) + JAD , 
XCENB , YCENB+RAD3 , XCENB+RAD3 , YCENB+RAD3 ,1,0 
WRITE (LU, 102 ) IX( IMID) -lAD, IX ( IMID)-IAD, lY ( JMID ) -JAD , lY ( JMID ) , 
XCENB-RAD3 , YCENB-RAD3 , XCENB-RAD3 , YCENB ,1.0 
WRITE ( LU , 1 0  2 ) IX ( IMID ) -lAD , IX ( IMID ) -lAD , lY ( JMID ) , lY ( JMID ) + JAD , 
XCENB-RAD3 , YCENB , XCENB-RAD3 , YCENB+RAD3 ,1.0 
WRITE ( LU , 102 ) IX ( IMID ) +IAD , IX ( IMID ) +IAD, lY ( JMID) -JAD, lY ( JMID ) 
XCENB+RAD3 , YCENB-RAD3 , XCENB+RAD3 , YCENB ,1.0 
WRITE ( LU , 1 02 ) IX ( IMID ) +IAD , IX ( IMID ) +IAD , I Y ( JMID ) , lY ( JMID ) + JAD 
XCENB+RAD3 , YCENB , XCENB+RAD3 , YCENB+RAD3 ,1.0 


C-pd - Shuffle  lines- 


WRITE ( LU , * ) 

WRITE (LU, 102) IX (IMID-1) ,IX(IMID)-IAD,IY( JMID) ,IY( JMID) , 

&  XCENB-DXI,YCENB,XCENB-RAD3,YCENB,1.0 

WRITE(LU,102)IX(IMID)-IAD,IX(IMID)  ,IY(JMID)  ,IY(JMID)  , 

S.  XCENB-RAD3,YCENB,XCENB,YCENB,1.0 

WRITE ( LU, 102) IX (IMID) , JX ( IMID )+IAD, IY( JMID ), lY (JMID) , 

St  XCENB,YCENB,XCENB+RAD3,YCENB,1 .0 

WRITE(LU,102)IX(IMID)+IAD,IX(IMID+1) ,IY{ JMID) ,IY(JMID) , 

St  XCENB+RAD3,YCENB,XCENB+DXI,Y(2ENB,1.0 

WRITE(LU,102)IX(IMID) ,IX(IMID) ,IY( JMID-1 ) ,IY( JMID)-JAD, 

&  XCENB,YCENB-DXI,XCENB,YCENB-RAD3,1.0  ■ 

WRITE ( LU, 102) IX ( IMID ), IX (IMID) , lY ( JMID )-JAD,IY( JMID) , 

S.  XCENB,YCENB-RAD3,XCENB,YCENB,1.0 

WRITE(LU,102)IX(IMID) ,IX( IMID) ,IY(JMID) , I Y ( JMID ) + JAD , 

St  XCENB,YCENB,XCENB,YCENB+RAD3,1.0 

WRITE ( LU, 102) IX ( IMID ), IX (IMID) ,IY( JMID)+JAD,IY( JMID+1 ) , 

St  XCENB,YCENB+RAD3,XCENB.YC2MB+DXI,1.0 

C 

WRITE(LU,*) 

WRITE ( LU , 1 0  3 ) IX ( IMID- 1 ) , IX ( IMID ) -lAD , I Y ( JMID- 1 ) , I Y ( JMID ) - JAD 
WRITE(LU,103)IX(IMID)-IAD,IX(IMID) ,IY(JMID-1) , lY ( JMID ) -JAD  ' 
WRITE ( LU , 1 0  3 ) IX ( IMID ) , IX ( IMID ) +IAD , lY ( JMID- 1 ) , lY ( JMID ) -JAD 
WRITE ( LU , 1 0  3 ) IX ( IMID ) +IAD , IX ( IMID+ 1 ) , I Y ( JMID- 1 ) , I Y ( JMID ) -JAD 
WRITE ( LU , 1 0  3 ) IX ( IMID-1 ) , IX ( IMID ) -lAD , I Y ( JMID ) -JAD , I Y ( JMID ) 
WRITE ( LU, 103 ) IX ( IMID) -lAD, IX (IMID) ,IY( JMID) -JAD, IY( JMID) 
WRITE ( LU , 1 0 3 ) IX ( IMID ) , IX ( IMID ) +IAD , I Y ( JMID ) - JAD , I Y ( JMID ) 
WRITE ( LU , 10  3 ) IX ( IMID ) +IAD , IX ( IMID+1 ) , lY ( JMID ) -JAD , lY ( JMID ) 
WRITE ( LU , 1 0  3 ) IX ( IMID- 1 ) , IX ( IMID ) -lAD , lY ( JMID ) , I Y ( JMID ) + JAD 
WRITE ( LU , 1 0 3 ) IX ( IMID ) -lAD , IX ( IMID ), lY ( JMID ), lY ( JMID )+ JAD 
WRITE ( LU , 1 0  3 ) IX ( IMID ) , IX ( IMID ) +IAD , lY ( JMID ) , lY ( JMID ) + JAD 
WRITE ( LU , 1 0  3 ) IX ( IMID ) +IAD , IX ( IMID+1 ) , lY ( JMID ) , lY ( JMID ) + JAD 
WRITE ( LU , 1 0  3 ) IX ( IMID- 1 ) , IX ( IMID ) -lAD , I Y ( JMID ) + JAD , I Y ( JMID+ 1  ) 
WRITE  ( LU ,  1 0  3  )  IX  ( IMID )  -lAD ,  IX  ( IMID ) ,  lY  ( JMID )  +  JAD ,  lY  (.JMID+1 ) 
WRITE ( LU , 1 0  3 ) IX ( IMID ) , IX ( IMID ) +IAD , lY ( JMID ) + JAD , I Y ( JMID+1 ) 
WRITE(LU,103 ) IX (IMID) +IAD, IX (IMID+1 ) ,IY( JMID) + JAD, iy( JMID+1 ) 
C 

CALL  WRTFI2 ( LU , IRX , IRY , IX , lY , IFSR , JFSR ) 

WRITE(LU,105)IX(1) , IX ( IRX+1 ) , lY ( 1 ) , lY ( IRY+1 ) 

GOTO  561 
ENDIF 

r* 

C-pd - Overwrite  line  info  with  arc  data - 

C-pd - Inner  circle - 

C 

ANGl*  0.0 

ANG2=  45.0 

ANG3*  90.0 

ANG4=135.0 

ANG5= 180.0 

ANG6=225.0 

ANG7=270.0 

ANG8=315.0 

IFST=IG(117)+1 

JFST=IG(137)+1 

IMID*IFST+1 

JMID=JFST+1 

ILST*IFST+2 

JLST=JFST+2 

IBEF=IFST-1 

JBEF»JFST-1 


IAPT*IPST+3 
JAFT=JFST+3 
WRITE ( LU , * ) 

WRITE(LU,104)IX(JPST) ,IX(IMID) ,IY(JPST) ,IY(JPST) , 

£■  XCENB,YCENB,RAD1,ANG6,ANG7,XP(IPST) 

WRITE ( LU, 104) IX (IMID) ,IX(ILST) ,IY(JFST) ,IY( JFST) , 

S>  XCENB,YCENB,  RADI,  ANG7,ANG8,XP(  IMID) 

WRITE ( LU, 104) IX (IFST) , IX ( IMID) , lY ( JLST ) , lY ( JLST ) , 

&  XCENB,YCENB, RADI, ANG4,ANG3,XP( IFST) 

WRITE (LU, 104) IX ( IMID ), IX (ILST) , lY ( JLST ), lY (JLST ) , 

&  XCENB,YCENB, RADI, ANG3,ANG2,XP( IMID) 

WRITE (LU, 104) IX (IFST) ,IX(IPST) ,IY( JFST) ,IY(JMID) , 

&  XCENB,YCENB, RADI, ANG6,ANG5,YP( JFST) 

WRITE(LU,104)IX(IFST) ,IX(IFST) ,IY(JMID) ,IY(JLST) , 

E.  XCENB,YCENB,RAD1,ANG5,ANG4,YP(JMID) 

WRITE (LU, 104) IX (ILST) ,IX( ILST) ,IY( JFST) ,IY(JMID) , 

£.  XCENB,YCENB,  RADI,  ANG8,ANG1,YP(  JFST) 

WRITE(LU,104)IX(ILST) ,IX(ILST) ,IY(JMID) ,IY(JLST) , 

E.  XCENB,YCENB,RAD1,ANG1,ANG2,YP(JMID) 

I 

C-pd - Shuffle  lines - 

C 

WRITE (LU, 102) IX (IMID) , IX( IMID) , lY (JFST ) ,IY(JMID) , 

E.  XCENB,YCENB-RADl,XCENB,YC3aiB,YP(JFST) 

WRITE(LU,102)IX(IMID) ,IX(IMID) ,IY( JMID) ,IY( JLST) , 

El  XC:ENB,YCENB,XCENB,YCENB+RAD1,YP(  JMID) 

WRITE(LU,102)IX(IFST) ,IX(IMID) ,IY( JMID) ,IY( JMID) , 

El  XCENB-RADl  ,YCENB,XCENB,YCENB,XP(IFST) 

WRITE ( LU, 102) IX ( IMID ), IX (ILST) ,IY( JMID) ,IY( JMID) , 

&  XCENB,YCENB,XCENB+RAD1,YCENB,XP(IMID) 

4 

C-pd - Outer  circle - 

« 

ANG01=  0.0 
ANG02=  0.0+TETT02 
ANG03=  45.0 
ANG04=  90.0-TETT04 
ANG05=  90.0 
ANG06=  90.0+TETT06 
ANG07=135.0 
ANG08=180 . 0-TETT08 
ANG09=180.0 
ANGl 0=180. 0+TETTl 0 
ANG11=225.0 
ANG12=270 . 0-TETT12 
ANG13=270.0 
ANGl 4=270 . 0+TETT14 
ANG15=315.0 
ANG16=360 . 0-TETT16 
IFST=IG(117 ) 

JFST=IG(137) 

IMID=IFST+2 
JMID=JFST+2 
IL3T=IFST+4 
JLST=JFST+4 
IBEF=IFST-1 
JBEF=JFST-1 
IAFT=IFST+5 
JAFT=JF3T^5 
WRITE ( LU, * ) 


o  n  o  o  o  o 


WRITE (LU, 

& 

WRITE ( LU , 

& 

WRITE ( LU , 

& 

WRITE (LU, 

& 

WRITE (LU, 

& 

WRITE (LU, 

& 

WRITE ( LU , 

& 

WRITE ( LU , 

& 

WRITE ( LU , 

& 

WRITE ( LU , 

Si 

WRITE (LU, 

El 

WRITE ( LU , 
Si 

WRITE (LU, 
Si 

WRITE ( LU , 

& 

WRITE ( LU , 

El 

WRITE (LU, 
Si 


104)IX(IFST) ,IX(IPST+1) ,iy(JFST) ,IY(JFST) , 
XCENA , YCENA , RAD2 , ANGl 1 , ANGl 2 , XP ( IFST ) 
104)IX(IFST+1) ,IX(IMID) ,IY(JFST) ,iy(JFST) , 

XCENA , YCENA , RAD2 , ANGl 2 , ANGl 3 , XP ( IFST+ 1 ) 
104)IX(IMID) ,IX(ILST-1) ,IY(JFST) ,IY(JFST) , 
XCENA , YCENA , RAD2 , ANGl 3 , ANGl 4 , XP ( IMID ) 
104)IX(ILST-1) ,IX(ILST) ,IY(JFST) ,IY(JFST) , 

XCENA , YCENA , RAD2 , ANGl 4 , ANGl 5 , XP ( ILST- 1 ) 
104)IX(IFST) ,IX(IFST+1) ,IY(JLST) ,IY(JLST) , 
XCENA , YCENA , RAD2 , ANGO  7 , ANGO  6 , XP ( IFST ) 
104)IX(IFST+1) ,IX(IMID) ,IY(JLST) ,IY( JLST) , 

XCENA , YCENA , RAD2 , ANG06 , ANGO  5 , XP ( IPST+ 1 ) 
104)IX(IMID) ,IX(ILST-1) ,IY( JLST) ,IY( JLST) , 
XCENA , YCENA , RAD2 , ANGO 5 , ANG04 , XP ( IMID ) 
104)IX(ILST-1) ,IX(ILST) , lY (JLST) , lY (JLST ) , 

XCENA , YCENA , RAD2 , ANG04 , ANGO  3 , XP ( ILST-1 ) 
104 ) IX ( IFST ), IX (IFST) ,IY( JFST) , lY ( JFST+1 ) , 
XCENA , YCENA , RAD2 , ANGl 1 , ANGl 0 , YP ( JFST ) 
104 ) IX ( IFST ), IX (IFST) ,IY( JFST+1 ) ,IY(JMID) , 

XCENA . YCENA , RAD2 , ANGl 0 , ANGO  9 , YP ( JPST+ 1 ) 
104)IX(IFST) ,IX(IPST) ,IY(JMID),IY(JLST-1) , 
XCENA , YCENA , RAD2 , ANG09 , ANGO 8 , YP ( JMID ) 
104)IX(IFST) ,IX(IFST) ,IY(JLST-1) ,IY(JLST) , 

XCENA , YCENA , RAD  2 , ANGO  8 , ANGO  7 , YP ( JLST- 1 ) 
104)IX(ILST) ,IX(ILST) , lY ( JFST ), lY ( JFST+1 ) , 
XCENA , YCENA , RAD2 , ANGl 5 , ANGl 6 , YP ( JFST ) 
104) IX (ILST) , IX (ILST) ,iy (JFST+1 ) ,IY( JMID) , 

XCENA , YCENA , RAD2 , ANGl 6 , ANGO 1 , YP ( JPST+ 1 ) 
104 ) IX ( ILST ), IX (ILST) ,IY(JMID) ,IY(JLST-1) , 
XCENA , YCENA , RAD2 , ANGO 1 , ANGO  2 , YP ( JMID ) 
104) IX (ILST) , IX (ILST) ,IY( JLST-1 ) , iy( JLST) , 

XCENA , YCENA , RAD2 , ANGO  2 , ANGO  3, YP( JLST-1) 


-pd - Shuffle  lines 


WRITE ( LU , 
Si 

WRITE (LU, 

Si 

WRITE ( LU , 
Si 

WRITE (LU, 
Si 

WRITE ( LU , 

6i 

WRITE ( LU , 
Si 

WRITE (LU, 
Si 

WRITE (LU, 


102) IX (IMID) , IX (IMID) ,IY(JBEF) ,IY( JFST) , 

XL ( IMID ) , YL ( JBEF ) , XCENA , yCENA-RAD2 , YP ( JBEF ) 
102)IX(IMID) ,IX(IMID) ,IY(JFST) ,iy( JFST+1 ) , 

XCENA , YCENA-RAD2 , XCENB , YCENB-RADl , YP ( JFST ) 
102)IX(IMID) ,IX(IMID) ,IY(JLST-1) ,IY(JLST) , 

XCENB , YCENB+RADl , XCENA , YCENA+RAD2 , YP ( JLST- 1 ) 
102)IX(IMID) ,IX(IMID) ,iy(JLST) ,iy( JAFT) , 

XCENA , YCENA+RAD2 , XL ( IMID ) , YL ( JAFT ) , YP ( JLST ) 
102)IX(IBEF) ,IX(IFST) ,IY(JMID) ,IY( JMID) , 

XL  ( IBEF )  ,  YL  ( JMID ) ,  XCENA-RAD2  ,  YCSINA ,  XP  ( IBEF ) 
102) IX (IFST) ,IX(IFST+1) ,IY( JMID) ,IY( JMID) , 

XCENA-RAD2 , YCENA , XCENB-RADl , YCENB , XP ( IFST ) 
102)IX(ILST-1) ,IX(ILST) ,IY(JMID) ,iy(JMID) , 

XCENB+RADl , YCENB , XCENA+RAD2 , YCENA , XP ( ILST- 1 ) 
102)IX(ILST) ,IX(IAFT) ,IY( JMID) ,iy( JMID) , 

XCENA+RAD2 , YCENA , XL ( lAFT ) , YL ( JMID ) , XP ( ILST ) 


-pd - More  trig - 

DELL02= ( RAD2*RAD2-DXI02*DXI02 ) **0 . 5 
DELL04= (RAD2*RAD2-DXI04*DXI04 ) **0 . 5 
DELL06=(RAD2*RAD2-DXI06*DXI06)*^0.5 
DELL08= (RAD2*RAD2-DXI08*DXI08 )**0.5 
dell: 0= (RAD2*RAD2-DXI10*DXI10 ) **0.5 
DELL12=(RAD2*RAD2-DXI12*DXI12)**0.5 


DELL14- ( RAD2*RAD2-DXI14*DXI14 ) **0 . 5 
DELL16= (RAD2*RAD2-DXI16*DXI16 ) **0 . 5 


WRITE(LU,*) 

WRITE(LU,102)IX(IFST+1) ,IX(IFST+1) ,iy(JBEF) ,IY(JFST) , 

S.  XL  ( IFST+1 )  ,  YL  ( JBEF )  ,  XL  ( IFST+1 )  ,  YCENA-DELL12  ,  YP  ( JBEF ) 

WRITE(LU,102)IX(IFST+1) ,IX(IFST+1) ,IY(JFST) ,IY(JFST+1) , 

&  XL (IFST+1) ,YCENA-DELL12,XL( IFST+1 ) ,YL(JFST+1) ,YP(JFST) 

WRITE ( LU, 1 02 ) IX ( IFST+1 ), IX (IFST+1 ) ,IY(JLST-1) ,IY(JLST) , 

Si  XL  (IFST+1)  ,YL(  JLST-1)  ,  XL  (IFST+1)  ,  YCENA+DELL06  ,  YP  ( JLST-1 ) 

WRITE ( LU, 102 ) IX ( IFST+1 ), IX (IFST+1 ) ,IY(JLST) ,IY(JAFT) , 

Si  XL  (IFST+1)  ,  YCENA+DELL06,  XL  ( IFST+1 )  ,YL(JAFT)  ,YP(JLST) 

WRITE(LU,102)IX(ILST-1) ,IX(ILST-1),1Y(JBEF) ,IY(JFST) , 

&  XL ( ILST-1 ) , YL ( JBEF ) , XL ( ILST-1 ) , YCENA-DELL14 , YP ( JBEF ) 

WRITE(LU,102)IX(ILST-1) ,IX(ILST-1) ,IY(JFST) ,IY(JFST+1) , 

Si  XL  ( ILST-1 )  ,  YCENA-DELL14 ,  XL  ( ILST-1 )  ,  YL  ( JFST+1 )  ,  YP  ( JFST ) 

WRITE(LU,102)IX(ILST-1) ,IX(ILST-1) ,IY( JLST-1) ,IY(JLST) , 

Si  XL(ILST-l)  ,  YL  ( JLST-1 ),  XL  (ILST-1)  ,  YCENA+DELL04  ,YP  ( JLST-1 ) 

WRITE ( LU, 102) IX ( ILST-1 ), IX (ILST-1 ) ,IY(JLST) ,IY(JAFT) , 

Si  XL  ( ILST- 1 )  ,  YCENA+DELL04 ,  XL  ( ILST- 1 )  ,  YL  ( JAFT )  ,  YP  ( JLST ) 

WRITE { LU, 102) IX (IBEF) , IX ( IFST) , lY ( JFST+1 ) ,IY(JFST+1) , 

Si  XL(IBEF)  ,YL(JFST+1)  ,XCENA- DELL  10, YL(  JFST+1)  ,XP(IBEF) 

WRITE (LU, 102) IX (IFST) , IX ( IFST+1 ), lY ( JFST+1 ) ,IY(JFST+1 ) , 

Si  XCENA-DELL10,YL(  JFST+1)  ,  XL  { IFST+1  )  ,YL(  JFST+1)  ,XP(IFST) 

WRITE ( LU , 102 ) IX ( ILST-1 ) , IX ( ILST ) , lY ( JFST+1 ) , lY ( JFST+1 ) , 

Si  XL { ILST-1)  , YL(  JFST+1 )  ,XCENA+DELL1 6, YL(  JFST+1)  ,XP(  ILST-1  ) 

WRITE (LU, 102) IX (ILST) , IX ( lAFT) , lY ( JFST+1 ) ,IY( JFST+1 ) , 

Si  XCENA+DELL16,  YL  ( JFST+1 ),  XL  (lAFT)  ,YL(  JFST+1 )  ,XP(  ILST) 

WRITE(LU,102)IX(IBEF) , IX( IFST) , lY (JLST-1 ), lY (JLST-1 ) , 

&  XL(IBEF) ,YL(JLST-1) ,XCENA-DELL08,YL(JLST-1) ,XP(IBEF) 

WRITE(LU,102)IX(IFST) , IX ( IFST+1 ), lY (JLST-1 ) ,IY( JLST-1) , 

&  XCENA-DELL08, YL( JLST-1 ), XL (IFST+1 ) ,YL( JLST-1 ) ,XP( IFST) 

WRITE(LU,102)IX(ILST-1) ,IX(ILST) ,IY(JLST-1) ,IY(JLST-1) , 

Si  XL(ILST-l)  ,YL(JLST-1)  ,XCENA+DELL02,YL(  JLST-1)  ,XP(ILST-1  ) 

WRITE (LU, 102) IX (ILST) ,IX(IAFT) ,IY(JLST-1 ) ,IY( JLST-1 ) , 

El  XCENA+DELLO  2 ,  YL  ( JLST- 1 )  ,  XL  ( lAFT )  ,  YL  ( JLST- 1 )  ,  XP  ( ILST ) 

WRITE ( LU , * ) 

:-pd - Add  lines  for  upper  gap - 

IF(I.EQ.2.0R.I.EQ.3)  THEN 
IADD=IG(61)/2 
XDST»RG(61)/2. 

XTP=1.0 

WRITE ( LU , 102 ) IX ( IMID ) -lADD , IX ( IMID ) -lADD , lY ( JAFT ) , lY ( IRY ) , 

Si  XCENA-XDST ,  YL  ( JAFT )  ,  XCENA-XDST ,  YL  ( IRY  )  ,  XTP 

WRITE ( LU , 1 02 ) IX ( IMID ) - lADD , IX ( IMID ) - lADD , I Y ( IRY ) , I Y ( IRY+ 1 ) , 

El  XCENA-XDST ,  YL  ( IRY )  ,  XCENA-XDST  ,  YL  ( IRY+1 )  ,  XTP 

WRITE ( LU, 102 ) IX ( IMID )+lADD, IX ( IMID )+IADD,IY( JAFT) ,IY(IRY) , 

£.  XCENA+XDST ,  YL  ( JAFT )  ,  XCENA+XDST  ,  YL  ( IRY  )  ,  XTP 

WRITE ( LU, 102 ) IX ( IMID )+IADD, IX ( IMID )+IADD,IY( IRY)  ,IY(IRY+1  )  , 

El  XCENA+ XDST,YL(  IRY  ),  XCENA+XDST,  YL(  IRY+1  )  ,XTP 

WRITE ( LU , 102 ) IX ( IMID ) -lADD , IX ( IMID ) +IADD , lY ( JAFT ) , lY ( JAFT ) , 

Si  XCENA-XDST ,  YL  ( JAFT )  ,  XCENA+XDST ,  YL  (  JAFT )  ,  XTP 

WRITE ( LU , 102 ) IX ( IMID ) -lADD , IX ( IMID ) +IADD , lY ( IRY ) , lY ( IRY ) , 

Si  XCENA-XDST ,  YL  ( IRY )  ,  XCENA+XDST ,  YL  { IRY  )  ,  XTP 

WRITE ( LU, 1 02 ) IX ( IMID )-IADD, IX ( IMID )+IADD,IY( IRY+1 ) ,IY(IRY+1 ) , 

Si  XCENA-XDST,  YLf  IRY+1 )  ,  XCENA+XDST  ,  YL  ^  IRY+1  i  ,  XT? 

ENDIF 


C-pd - Overwrite  line  info  with  arc  data - 

c 

IFSR=IG(117)+1 

JFSR*IG(137)+1 

IMID*IFSR+1 

JMID*JPSR+1 

IAD=IG(50) 

JAD=IG(51) 

RAD3=RG(53)/2. 

IF(I.EQ.5)  THEN 
XCENB»RG(45) 

YCENB*RG(46) 

RAD3*=RG(54)/2. 

ENDIP 

C 

WRITE { LU  * ) 

WRITE ( LU ! 1 04 ) IX ( IMID ) - lAD , rX ( IMID ) , lY ( JMID ) - JAD , lY ( JMID ) - JAD , 
&  XCENB,YCENB,RAD3,ANG6,ANG7,1.0 

WRITE ( LU , 104 ) IX ( IMID ) , IX ( IMID ) +IAD, lY { JMID ) - JAD , lY ( JMID ) - JAD , 
&  XCENB,YCENB,RAD3,ANG7,ANG8,1.0 

WRITE ( LU, 104 ) IX ( IMID )-IAD, IX (IMID) , lY ( JMID )+ JAD , lY ( JMID )+ JAD , 
&  XCENB,YCENB,RAD3,ANG4,ANG3,1.0 

WRITE ( LU , 1 04 ) IX ( IMID ) , IX ( IMID ) +IAD , lY ( JMID ) + JAD , lY ( JMID ) + JAD , 
&  XCENB,YCENB,RAD3,ANG3,ANG2,1.0 

WRITE ( LU , 1 04 ) IX ( IMID ) -lAD , IX ( IMID ) -lAD , lY ( JMID ) -JAD , lY ( JMID ) , 
&  XCENB,YCENB,RAD3,ANG6,ANG5,1.0 

WRITE ( LU , 1 04 ) IX ( IMID ) -lAD , IX ( IMID ) -lAD , lY ( JMID ) , I Y ( JMID ) + JAD , 
£>  XCENB ,  YCENB , RAD3  ,  ANG5 ,  ANG4 ,1.0 

WRITE ( LU , 1 04 ) IX ( IMID ) +IAD , IX ( IMID ) +IAD , I Y ( JMID ) -JAD , I Y ( JMID )  , 
&  XCENB, YCENB, RAD 3, ANG8,ANG1, 1.0 

WRITE ( LU , 104 ) IX ( IMID ) +IAD , IX ( IMID ) +IAD , lY { JMID ) , lY ( JMID ) + JAD , 
6.  XCENB,  YCENB,  RAD  3,  ANG1,ANG2, 1.0 

C 

C-pd - Shuffle  lines - 

C 

XCENC= XCENB 
YCENC= YCENB 
IF(I.EQ.5)  THEN 
XCENC=RG(43) 

YCENC=RG(44) 

ENDIP 

WRITE ( LU , * ) 

WRITE (LU, 102) IX (IMID-1) , IX ( IMID ) -lAD, lY ( JMID ) ,IY(JMID) , 

&  XCENC-RAD1,YCENC, XCENB-RAD3, YCENB,! .0 

WRITE(LU,102)IX(IMID)-IAD,IX(IMID) ,IY(JMID) ,IY(JMID) , 

&  XCENB-RAD3, YCENB, XCENB, YCENB, 1.0 

WRITE(LU,102)IX(IMID) , IX (IMID) +IAD,IY( JMID) ,IY( JMID) , 

&  XCENB, YCENB, XCENB+RAD 3^ YCENB, 1.0 

WRITE (LU, 102) IX ( IMID )+IAD, IX ( IMID+1 ) ,IY( JMID) ,IY( JMID) , 

E<  XCENB+RAD3  ,  YCENB ,  XCENC+RADl ,  YCENC  ,1.0 

WRITE (LU, 102) IX (IMID) , IX (IMID) ,IY(JMID-1 ) , lY ( JMID ) -JAD , 

S.  XCENC ,  YCENC-RADl , XCENB ,  YCENB-RAD3 ,1.0 

WRITE (LU, 102) IX (IMID) , IX (IMID) , lY (JMID ) -JAD , lY ( JMID 1 , 

£<  XCENB ,  YCENB  -  RAD  3  ,  XCENB ,  YCENB  ,1.0 

WRITE (LU, 102) IX (IMID) ,IX(IMID) , lY (JMID ), lY ( JMID )+ JAD , 

&  XCENB , YCENB , XCENB , YCENB+RAD  3,1.0 

WRITE ( LU, 102 ) IX (IMID) , IX ( IMID ), lY ( JMID) + JAD , lY ( JMID+1 ) , 

St  XCENB,  YCENB+RAD 3  .XCENC, YCENC-t-RADl  ,1.0 

r> 


WRITE ( LU , * ) 


WRITE ( LU , 1 0  3 ) IX ( IMID- 1 ) , IX ( IMID ) -lAD , lY ( JMID- 1 ) , I Y ( JMID ) - JAD 
WRITE ( LU , 1 0  3 ) IX ( IMID ) -lAD , IX ( IMID ) , lY ( JMID- 1 ) , lY ( JMID ) -JAD 
WRITE ( LU , 1 0  3 ) IX ( IMID ) , IX ( IMID ) +IAD , lY ( JMID- 1 ) , lY ( JMID ) -JAD 
WRITE ( LU , 10  3 ) IX ( IMID ) +IAD , IX ( IMID+1 ) , lY ( JMID- 1 ) , lY ( JMID ) -JAD 
WRITE ( LU , 1 0  3 ) IX ( IMID- 1 ) , IX ( IMID ) -lAD , lY ( JMID ) -JAD , lY ( JMID ) 

WRITE ( LU , 1 0  3 ) IX ( IMID ) -lAD , IX ( IMID ) . lY ( JMID ) -JAD , lY ( JMID ) 

WRITE ( LU , 1 0  3 ) IX ( IMID ) , IX ( IMID ) +IAD , lY { JMID ) -JAD , lY { JMID ) 

WRITE ( LU , 1 0  3 ) IX ( IMID ) +IAD , IX ( IMID+ 1 ) , lY ( JMID ) -JAD , lY ( JMID ) 

WRITE ( LU , 1 0  3 ) IX { IMID- 1 ) , IX ( IMID ) -lAD , lY ( JMID ) , I Y ( JMID ) + JAD 
WRITE(LU,103 )IX(IMID)-IAD,IX(IMID) .IY( JMID) , lY (JMID) + JAD 
WRITE ( LU , 1 0  3 ) IX ( IMID ) , IX ( IMID ) +IAD , lY ( JMID ) , I Y ( JMID ) + JAD 
WRITE ( LU , 1 0  3 ) IX ( IMID ) +IAD , IX ( IMID+1 ) , lY ( JMID ) , lY ( JMID ) + JAD 
WRITE ( LU , 1 0  3 ) IX ( IMID- 1 ) , IX ( IMID ) -lAD , lY ( JMID ) + JAD , lY ( JMID+1 ) 

WRITE ( LU , 1 0  3 ) IX ( IMID ) -lAD , IX ( IMID ) , lY ( JMID ) + JAD , lY { JMID+1 ) 

WRITE ( LU , 1 0  3 ) IX ( IMID ) , IX { IMID ) +IAD , lY ( JMID ) +JAD , lY ( JMID+1 ) 

WRITE ( LU , 1 0  3 ) IX ( IMID ) +IAD , IX ( IMID+1 ) , lY ( JMID ) + JAD , lY ( JMID+1 ) 

CALL  WRTFI 2 ( LU , IRX , IRY , IX . lY , IFSR , JFSR ) 

:-pd - Fix  points  around  circle  and  certain  ones  inside - 

C 

WRITE ( LU , * ) 

WRITE(LU,105)IX(1) ,IX(IRX+1) , lY { 1 ) ,IY(JFST) 

WRITE ( LU , 1 05 ) IX ( 1 ) , IX ( IFST ) , lY ( JFST ) , I Y ( JLST ) 

WRITE ( LU, 105) IX (ILST) ,IX(IRX+1) ,IY(JFST) ,IY(JLST) 
WRITE(LU,105)IX(1) ,IX(IRX+1) ,IY(JLST) ,IY(IRY+1) 

ISOL=3 

WRITE(LU,105)IX(IFST+1 )+ISOL,IX(ILST-l )-IS0L,IY{ JFST+1 ) ,IY( JLST-1  ) 
WRITE (LU, 105) IX (IFST+1) , IX ( ILST-1 ), lY ( JFST+1 ) +ISOL , lY ( JLST-1 ) -ISOL 

WRITE (LU, 105) IX (IFST+1) ,IX(iLST-l) ,IY(JFST) ,IY(JFST+1) 

WRITE (LU, 105) IX (IFST) , IX (IFST+1) ,IY( JFST+1) ,IY( JLST-1) 

WRITE (LU, 105) IX (ILST-1) , IX ( ILST ), lY ( JFST+1 ) ,IY( JLST-1) 

WRITE (LU, 105) IX (IFST+1) , IX ( ILST-1 ), lY ( JLST- 1 ) ,IY(JLST) 

561  COI^INUE 
C 

Q***************************************»t******************************* 

I-pd This  is  the  second  option  for  exit  of  the  engine.  There  will-- 

C will  be  either  2  or  3  cross  sections  written  here  depending - 

C on  the  location  exit.  It  will  be  2  if  it  ends  before  the - 

2 augmenter  tube  or  if  it  ends  at  the  start  of  the  tappered - 

2 -  section  or  at  the  start  of  straight  section.  It  will  be  3 - 

C -  if  it  falls  in  the  tappered  section  or  after  the  start  of - 

C -  the  straight  section. - 

:  t3 

DO  563  I=1,IG(60) 

IX(1  )=1 

CALL  SETIV(IX,IG,140,1,NI) 

's.' 

XCENC=RG(47 ) 

YCENC=RG( 48 ) 

XCEND=RG( 47  ) 

YCEND=RG( 48 ) 

RAD1=RG( 54 )/2. 

DXI= f RADl*RADl/2 . i»*0.5 
RAD  2  =  r.G  (  5  4  I  ,  /  2  . 

DXII= (RAD2*RAD2/2 .  )**0.5 


IFST=IG(157) 

JFST=IG(177) 

C 

C-pd - Do  trig - 

C 

DXI02=DXI+ { YCENC-YCEND ) 

TETT02=ASIN(DXI02/RAD2) *180./ 3. 141592654 
DXI16=DXI- (YCENC-YCEND) 

TETT16=ASIN(DXI16/RAD2)*180./3. 141592654 
DXI04=DXI+ ( XCENC-XCEND ) 

TETT04=ASIN(DXI04/RAD2 ) *180 . /3 . 141592654 
DXI 0  6 =DXI - ( XCENC-XCEND ) 

TETT06=ASIN(DXI06/RAD2 ) *180. /3. 141592654 
DXI08=DXI+ ( YCENC-YCEND ) 

TETT08=ASIN (DXI08/RAD2 ) *180 . /3 . 141592654 
DXI 1 0 =DXI - ( YCENC-YCEND ) 

TETT10=ASIN(DXI10/RAD2) *180. /3. 141592654 
DXI 1 2 =DXI -( XCENC-XCEND ) 

TETT12=ASIN(DXI12/RAD2 ) *180 . /3 . 141592654 
DXIl 4=DXI+ ( XCENC-XCEND ) 

TETT14=ASIN(DXI14/RAD2) *180./ 3. 141592654 

r* 

IRX=IG{44) 

IRY=IG(45) 

XL(1  )=0.0 

CALL  SETRV(XL,RG,180,1,NI) 

XL ( IFST+1 ) =XCEND-DXI 
XL ( IFST+  3 ) =XCEND+DXI 
XL ( IFST  ) =XCEND-DXII 
XL ( IPST+4 ) =XCEND+DXII 

XL  ( IFST-1  )  =XCEND-  (  ( XCEND-RAD2  )  /  2 .  )  -RAD2 
XL(IFST+5)=XCEND+( ( XL ( IRX+1 ) -XCEND-RAD2 ) /2 . )+RAD2 

CALL  SETRV(XP,RG,200,2,NI) 

IY(1  )=1 

CALL  SETIV(IY,IG,160,1,NI) 

C 

YL(1  )=0.0 

CALL  SETRV(yL,RG,220,l,NI) 

YL ( JFST+1 ) =YCEND-DXI 
YL ( JFST+  3 ) = YCEND+DXI 
YL ( JFST  ) =YCEND-DXII 
YL ( JFST+4 ) =yCEND+DXII 

YL{ JFST-1 )=YCEND-{ ( YCEND-RAD2 ) /2 . )-RAD2 

YL( JFST+5 )=YCEND+( ( YL ( IRY+1 ) -YCEND-RAD2 ) /2 . ) +RAD2 

CALL  SETRV{YP,RG,240,2,N1 ) 

LU=65+I 

CG  (  LU  )  =  '  CS  ' 

I10=LU/10 

I1=LU-I10*10 

WRITE(CG(LU)  (  3:  3)  ,  '  (li  )  '  )  HO 
WRITE(CG(LU) (4:4) , ' (II)  '  )  H 

OPEN ( LU , FILE=CG ( LU ) , FORM= ' FORMATTED' , STATUS = ' UNKNOWN ' ) 
IF  '  ?Gf  C  ;  .  NE  .  0 . 0  )  XL  ?  1  )  =RG.'  LU-^:  C  ' 

CALL  WRTSQ ( LU , NX , NY , IRX , IRY , IX , I Y , XL , YL , XF , YP ) 


C-pd - Overwrite  line  info  with  arc  data - 

"-pd - Inner  circle - 

XCENC=RG(45) 

yCENC»RG(46) 

ANG1=  0.0 

ANG2=  45.0 

ANG3*  90.0 

ANG4=135.0 

ANG5=180.0 

ANG6=225.0 

ANG7=270.0 

ANG0=315.O 

IFST=IG(157)+1 

JFST=IG(177)+1 

IMID=IFST+1 

JMID=JFST+1 

ILST=IFST+2 

JLST=JFST+2 

IBEF=IFST-1 

JBEF=JFST-1 

IAFT=IFST+3 

JAFT=JFST+3 

WRITE ( LU, * ) 

WRITE ( LU, 104) IX (IFST) ,IX(IMID) ,IY(JFST) ,IY(JFST) , 

&  XCENC,YCENC. RADI, ANG6,ANG7,XP( IFST) 

WRITE{LU,104)IX(IMID) ,IX{ILST) ,IY{JFST) ,IY( JFST) , 

&  XCENC , YCENC , RADI , ANG7 , ANG8 , XP ( IMID ) 

WRITE(LU,104)IX{IFST) ,IX(IMID) ,IY( JLST) ,IY( JLST) , 

&  XCENC , YCENC , RADI , ANG4 , ANG  3 , XP ( IFST ) 

WRITE(LU,104)IX(IMID) ,IX(ILST) ,IY(JLST) ,IY(JLST) , 

&  XCENC, YCENC, RADI ,ANG3,ANG2,XP( IMID) 

WRITE ( LU , 104 ) IX ( IFST ) , IX ( IFST ) , lY ( JFST ) , lY ( JMID ) , 

&  XCENC , YCENC , RADI , ANG6 , ANG5 , YP ( JFST ) 

WRITE (LU, 104) IX (IFST) ,IX(IFST) ,IY(JMID) ,iy(JLST) , 

&  XCENC , YCENC , RADI , ANG5 , ANG4 , YP ( JMID ) 

WRITE ( LU, 104) IX (ILST) , IX ( ILST) , lY ( JFST ) ,IY( JMID) , 

S.  XCENC ,  YCENC ,  RADI ,  ANG8 ,  ANGl ,  YP  ( JFST ) 

WRITE (LU, 104) IX (ILST) ,IX( ILST) ,IY( JMID) ,IY( JLST) , 

&  XCENC , YCENC , RADI , ANGl , ANG2 , Y P ( JMID ) 

C 

:-pd - Shuffle  lines - 

WRITE (LU, 102) IX (IMID) , IX ( IMID) , lY ( JFST ) ,IY( JMID) , 

&  XCENC , YCENC-RADl , XCENC , YCENC , YP ( JFST ) 

WRITE (LU, 102) IX (IMID) , IX ( IMID ), lY ( JMID ) ,IY( JLST) , 

S.  XCENC ,  YCENC ,  XCENC ,  YCENC+RADl ,  YP  ( JMID ) 

WRITE (LU, 102) IX (IFST) , IX ( IMID ), lY (JMID) ,IY( JMID) , 

&  XCENC-RADl , YCENC , XCENC , YCENC , XP ( IFST ) 

WRITE(LU,102)IX(IMID) , IX ( ILST ), lY ( JMID ) ,IY( JMID) , 

&  XCENC , YCENC , XCENC+RADl . YCENC , XP ( IMID ) 

I-pd - Outer  circle - . - 

C 

ANG01=  0.0 
ANG02=  0.0+TETT02 
ANG03=  45.0 
ANG04=  9C.0-TETT04 
ANG05=  90.0 


ANG06=  90.0+TETT06 

ANG07=135.0 

ANGO  8=180. 0 -TETTO  8 

ANG09=180.0 

ANG10=180 . O+TETTIO 

ANG11=225.0 

ANG12=270 . 0-TETT12 

ANG13=270.0 

ANG14=270 . 0+TETT14 

ANG15=315.0 

ANGl 6=360. 0 -TETTl 6 

IFST=IG(157) 

JFST=IG(177) 

IMID=IFST+2 
JMID=JFST+2 
ILST=IFST+4 
JLST=JFST+4 
IBEF=IFST-1 
JBEF=JFST-1 
IAFT=IFST+5 
JAFT=JFST+5 
WRITE ( LU , * ) 

WRITE ( LU , 1 04 ) IX ( IFST ) , IX ( IFST+ 1 ) , IF ( JFST ) , IF ( JFST ) , 

&  XCEND ,FCEND ,RAD2 ,ANG11 ,ANG12 , XP ( IFST ) 

WRITE(LU,104)IX(IFST+1 ) , IX ( IMID ) , IF ( JFST ) , IF ( JFST ) , 

E.  XCEND ,  FCEND ,  RAD2 ,  ANGl  2 ,  ANGl  3 ,  XP  ( IFST+ 1 ) 

WRITE(LU,104)IX(IMID) ,IX(ILST-1) ,IF(JPST) ,IF(JPST) , 

E>  XCEND ,  FCEND ,  RAD2  ,  ANGl  3  ,  ANGl  4  ,  XP  ( IMID ) 

WRITE ( LU, 104) IX (ILST-1) ,IX(ILST) , IF (JFST ), IF (JFST ) , 

&  XCEND , FCEND , RAD2 , ANGl 4 , ANGl 5 , XP ( ILST- 1 ) 

WRITE (LU, 104) IX (IFST) , IX ( IFST+1 ) ,IF ( JLST) , IF ( JLST ) , 

&  XCEND , FCEND , RAD2 , ANGO  7 , ANGO  6 , XP ( IFST ) 

WRITE (LU, 104) IX ( IFST+1 ), IX (IMID) ,IF(JLST) ,IF(JLST) , 

&  XCEND , FCEND , RAD2 , ANGO  6 , ANGO  5 , XP ( IFST+ 1 ) 

WRITE (LU, 104) IX (IMID) , IX ( ILST-1 ), IF (JLST ) ,IF(JLST) , 

&  XCEND , FCEND , RAD2 , ANG05 , ANG04 , XP ( IMID ) 

WRITE (LU, 104) IX (ILST-1) , IX (ILST) , IF (JLST) , IF (JLST) , 

&  XCEND , FCEND , RAD2 , ANGO  4 , ANGO  3,XP(ILST-1) 

WRITE (LU, 104) IX (IFST) ,IX{IFST) , IF ( JFST ) , IF ( JFST+1 ) , 

&  XCEND , FCEND , RAD2 , ANGl 1 , ANGl 0 , FP ( JFST ) 

WRITE (LU, 104) IX (IFST) , IX ( IFST ), IF (JFST+1 ), IF (JMID) . 

&  XCEND , FCEND , RAD2 , ANGl 0 , ANGO  9 , FP ( JFST+ 1 ) 

WRITE (LU, 104) IX (IFST) , IX ( IFST ) , IF ( JMID) , IF ( JLST-1 ) , 

&  XCEND, FCEND, RAD2,ANG09, ANGO 8, FP( JMID) 

WRITE (LU, 104) IX (IFST) ,IX(IFST) ,IF( JLST-1 ), IF (JLST) , 

&  XCEND , FCEND , RAD2 , ANGO  8 , ANGO  7 , FP ( JLST- 1 ) 

WRITE(LU,104)IX(ILST) ,IX(ILST) , IF (JFST ), IF ( JFST+1 ) , 

&  XCEND, FCEND, RAD2, ANGl 5, ANGl 6, FP( JFST) 

WRITE ( LU, 104) IX ( ILST ), IX (ILST) , IF ( JFST+1 ), IF (JMID) , 

G.  XCEND ,  FCEND ,  RAD 2  ,  ANGl  6  ,  ANGO  1 ,  Y P  ( JFST+ 1 ) 

WRITE ( LU,1 04 ) IX (ILST) , IX (ILST) , IF (JMID) ,IY( JLST-1 ) , 

G.  XCEND ,  FCEND ,  RAD2  ,  ANGO  1 ,  ANGO  2  ,  YP  ( JMID ) 

WRITE(LU,104 )IX(ILST) , IX (ILST) ,IY( JLST-1) ,IY(JLST) , 

G.  XCEND, YCEND, RAD2, ANG02, ANG03  ,YP(  JLST-1  ). 

C 

C-pd - Shuffle  lines - 

C 

WRITE (LU, 102) IX (IMID) , IX (IMID) ,IY(JBEF) ,IY( JFST) , 

G.  XL  (IMID)  ,yL(  JEEF)  ,  XCEND ,  YCEND-RAD2  ,  YP  (  JBEF  ; 

WRITE (LU, 102) IX (IMID) , IX (IMID) ,IY(JFST) ,IY( JFST+1 ) , 


&  XCEND , YCEND-RAD2 , XCENC , YCENC-RADl , YP ( JFST ) 

WRITE ( LU, 102) IX (IMID) ,IX(IMID) ,IY( JLST-1 ) ,IY( JLST) , 

&  XCENC, YCENC+RADl, XCEND, YCEND+RAD2,YP( JLST-1 ) 

WRITE (LU, 102) IX (IMID) ,IX(IMID) ,IY( JLST) ,IY( JAFT) , 

&  XCEND, YCEND+RAD2, XL (IMID) ,YL( JAFT) ,YP( JLST) 

WRITE ( LU, 102) IX (IBEF) ,IX(IFST) ,IY( JMID) ,IY( JMID) , 

&  XL ( IBEF ) , YL ( JMID ) , XCEND-RAD2 , YCEND , XP ( IBEF ) 

WRITE(LU,102)IX(IFST) ,IX(IFST+1) ,IY(JMID) ,IY( JMID) , 

&  XCEND-RAD2 , YCEND , XCENC-RADl , YCENC , XP ( IFST ) 

WRITE (LU, 102) IX (ILST-1) , IX ( ILST) , lY ( JMID ), lY (JMID ) , 

&  XCENC+RADl , YCENC , XCEND+RAD2 , YCEND , XP ( ILST- 1  ) 

WRITE(LU,102)IX(ILST) , IX ( lAFT) , lY (JMID ), lY ( JMID )  , 

&  XCEND+RAD2, YCEND, XL (lAFT) ,YL(JMID) ,XP(ILST) 

C-pd - More  trig - 

DELL02* (RAD2*RAD2-DXI02*DXI02 ) **0 . 5 
DELL04= ( RAD2*RAD2-DXI04*DXI04 ) **0 . 5 
DELL06= ( RAD2*RAD2-DXI06*DXI06 ) **0 . 5 
DELL08= ( RAD2*RAD2-DXI08*DXI08 ) **0 . 5 
DELL10=(RAD2*RAD2-DXI10*DXI10)**0.5 
DELL12=(RAD2*RAD2-DXI12*DXI12)**0.5 
DELL14=(RAD2*RAD2-DXI14*DXI14)**0.5 
DELL16= (RAD2*RAD2-DXI16*DXI16)**0.5 
C 

WRITE ( LU , * ) 

WRITE (LU, 102) IX (IFST+1) , IX( IFST+1 ) , lY ( JBEF) ,IY(JFST) , 

&  XL(IFST+1) ,YL(JBEF) , XL ( IFST+1 ) ,YCEND-DELL1 2 ,YP( JBEF) 

WRITE(LU,102)IX(IFST+1) ,IX(IFST+1) ,IY(JFST) ,IY(JFST+1) , 

6.  XL  ( IFST+1 )  ,  YCEND-DELL12 ,  XCENC-DXI ,  YCENC-DXI ,  YP  ( JFST ) 

WRITE(LU,102)IX(IFST+1) ,IX(IFST+1) ,IY(JLST-1) ,IY(JLST) , 

&  XCENC-DXI , YCENC+DXI , XL ( IFST+1 ) , YCEND+DELL06 , YP ( JLST-1  ) 

WRITE ( LU, 1 02) IX ( IFST+1 ), IX (IFST+1 ) ,IY( JLST) ,IY(JAFT) , 

&  XL ( IFST+1 ) , YCEND+DELL06 , XL ( IFST+1 ) , YL ( JAFT ) , YP ( JLST ) 

WRITE(LU,102)IX(ILST-1) ,IX(ILST-1) ,IY(JBEF) ,IY(JFST) , 

&  XL (ILST-1) ,YL(JBEF) , XL (ILST-1) , YCEND-DELL14 , YP ( JBEF  ) 

WRITE (LU, 102) IX (ILST-1) , IX ( ILST-1 ), lY (JFST ) ,IY(JFST+1) , 

&  XL (ILST-1 ) ,YCEND-DELL14,XCENC+DXI, YCENC-DXI, YP( JFST) 

WRITE (LU, 102) IX (ILST-1) , IX ( ILST-1 ), lY ( JLST-1 ) ,IY(JLST) , 

E.  XCENC+DXI, YCENC+DXI, XL(ILST-l)  ,YCEND+DELL04,YP(  JLST-1 ) 

WRITE ( LU, 1 02 ) IX ( ILST-1 ), IX (ILST-1 ), IK JLST) ,iy( JAFT) , 

&  XL (ILST-1) ,YCEND+DELL04,XL(ILST-1 ) ,YL(JAFT) ,YP(JLST) 

WRITE  (LU,  102) IX (IBEF) , IX ( IFST) , lY ( JFST+1 ) , lY ( JFST+1 ) , 

Sc  XL  (IBEF)  ,YL(  JFST+1 )  ,XCEND-DELL10  ,YL(  JFST+1 )  ,XP(IBEF) 

WRITE ( LU, 102 ) IX ( IFST ), IX (IFST+1 ) ,IY( JFST+1 ) ,IY( JFST+1) , 

S.  XCEND-DELLl  0,YL(  JFST+1 ),  XCENC-DXI,  YCENC-DXI,  XP(  IFST) 

WRITE(LU,102)IX(ILST-1) ,IX(ILST) ,IY(JFST+1) ,IY(JFST+1) , 

Sc  XCENC+DXI,  YCENC-DXI,  XCEND+DELLl  6,  YL(  JFST+1)  ,XP(  ILST-1  ) 

WRITE (LU, 102) IX (ILST) , IX ( lAFT ), lY ( JFST+1 ) ,IY( JFST+1 ) , 

S.  XCEND+DELLl 6, YL ( JFST+1 ), XL (lAFT)  ,YL( JFST+1)  ,XP{ILST) 

WRITE (LU, 102) IX (IBEF) , IX { IFST) , lY ( JLST-1 ) ,IY(JLST-1) , 

Sc  XL  (IBEF)  ,  YL  ( JLST- 1),  XCEND- DELLO  8,  YL(  JLST-1)  ,XP(IBEF) 

WRITE (LU, 102) IX (IFST) , IX ( IFST+1 ), lY ( JLST-1 ) ,IY( JLST-1 ) , 

Sc  XCEND-DELLO  8  ,  YL  ( JLST- 1 )  ,  XCENC-DXI ,  YCENC+DXI ,  XP  ( IFST  ) 

WRITE(LU,102)IX(ILST-1) , IX ( ILST ), lY ( JLST-1 ) ,IY(JLST-1) , 

Sc  XCENC+DXI,  YCENC+DXI,  XCEND+DELL02,YL(  JLST-1  )  ,XP(  ILST-1  ) 

WRITE(LU,102)IX(ILST) , IX ( lAFT) , IY( JLST-1 ) ,IY(JLST-1 ) , 

S.  XCEND+DELL02,YL(  JLST-1 )  ,XL(IAFT)  ,  YL(  JLST-i  )  ,XP(  ILST) 


o  cj  o  o  (1  o  o  o  non 


CALL  WRTFI(LU,IRX,IRY.IX,IY) 

-pd - Fix  points  around  circle  and  certain  ones  inside - 

WRITE(LU,*) 

WR1TE(LU,105)IX(1) ,IX(IRX+1) ,IY(1) ,IY(JFST) 

WRITE(LU,105)IX(1) ,IX(IFST) , lY ( JFST ) , lY ( JLST ) 

WRITE (LU, 105) IX (ILST) . IX ( IRX+1 ) , lY ( JFST ) ,TY(JLST) 
WRITE(LU,105)IX(1) ,IX(IRX+1) ,IY(JLST) ,IY(IRY+1) 

IS0L=2 

WRITE ( LU ,  1 05 ) IX ( IFST+1 ) -USOL ,  IX ( ILST-1 )  -ISOL ,  lY  ( JFST+1 )  ,  lY  ( JLST-1 ) 
WRITE ( LU , 105 ) IX ( IFST+1 ) , IX ( ILST-1 ) , lY ( JFST+1 ) +IS0L , lY ( JLST-1 ) -ISOL 

WRITE ( LU, 1 05 ) IX ( IFST+1 ), IX (ILST-1 ) ,IY( JFST) ,IY( JFST+1) 

WRITE ( LU, 105) IX ( IFST ), IX (IFST+1 ) ,IY( JFST+1 ) ,IY( JLST-1) 

WRITE (LU, 105) IX (ILST-1) , IX (ILST) ,IY( JFST+1 ) ,IY( JLST-1 ) 

WRITE (LU, 105) IX (IFST+1) , IX ( ILST-1 ), IY( JLST-1 ), lY (JLST ) 

563  CONTINUE 

★**************************★*********:********************************** 

-pd - This  section  is  for  the  constant  cross  sectional  area  of  the - 

-  augmenter  sleeve. - 

t4 

DO  564  1=1,3 
C 

•  IX(1  )=1 

CALL  SETIV(IX,IG,180,1,NI) 

C 

XCEND-RG(47) 

YCEND»RG(48) 

RADl=RG(56+I)/2. 

IF(IG(60) .EQ.2.AND.I.E0.1)  RAD1=RG( 56 ) /2  . 

DXI=(RADl*RADl/2. )**0.5 
IFST=IG(197) 

JFST=IG(217) 

IMID=IFST+1 
JMID= JFST+1 
ILST=IFST+2 
JLST=JFST+2 
IBEF»IFST-1 
JBEF«JFST-1 
IAFT-IFST+3 
JAFT=JFST+3 
C 

IRX«IG(46) 

IRY=IG(47 ) 

Q 

XL(1  )=0.0 

CALL  SETRV(XL,RG,260,1,NI) 

XL (IFST  )=XCEND-DXI 
XL ( IFST+2 ) =XCEND+DXI 

XL(IFST-1 )=XCEND-( ( XCEND-RADl ) /2 . ) -RADI 
XL(IFST+3)=XCEND+( ( XL ( IRX+1 ) -XCEND-RADl ) /2 . )+RADl 

CALL  SETRV(XP,RG,280,2,NI) 

iY(i  )=: 

CALL  SETIV(IY,IG,200,1,NI ) 


c 

YLd  )«0,0 

CALL  SETRV(yL,RG,300,l,NI) 

YL ( JFST  ) =YCEND-DXI 
YL ( JFST+2 ) *YCEND+DXI 

YL(JFST-l)=YCEND-( ( YCEND-RADl ) /2 • ) -RADI 
YL( JFST+3 )=YCEND+( ( YL ( IRY+1 ) -YCEND-RADl ) /2 . )+RADl 
C 

CALL  SETRV(YP,RG,320,2,NI) 

LU=65+IG(60)+I 
CG(LU)='CS  ' 

I10»LU/10 

I1=LU-I10*10 

WRITE(CG(L0)(3;3),'(I1)')  HO 
WRITECCG(LU) (4:4) , ' (II) ' )  H 

OPEN  ( LU ,  PILE=CG  ( LU )  ,  FORM=  '  FORMATTED ' ,  STATUS  =  '  UNKNOWN '  ) 
IF(RG(LU+10) .NE.0.0)  XL ( 1 ) =RG(LU+10 ) 

CALL  WRTSQ(LU,NX,NY,IRX,IRY,IX,IY,XL,YL,XP,YP) 

C-pd - Overwrite  line  info  with  arc  data - 

C 

ANG1=  0.0 
ANG2=  45.0 
ANG3=  90.0 
ANG4=135.0 
ANG5=180.0 
ANG6=225.0 
ANG7=270.0 
ANG8*315.0 
WRITE(LU,*) 

WRITE ( LU, 104) IX (IFST) , IX ( IMID) , IY ( JFST ) ,IY(JFST) , 

&  XCEND,YCEND, RADI, ANG6,ANG7,XP( IFST) 

WRITE (LU, 104) IX (IMID) ,IX(ILST) , IY ( JFST ), IY ( JFST ) , 

&  XCEND,YCEND, RADI, ANG7,ANG8,XP( IMID) 

WRITE (LU, 104) IX (IFST) ,IX(IMID) ,IY( JLST) ,IY( JLST) , 

&  XCEND,YCEND,RAD1,ANG4,ANG3,XP(IFST) 

WRITE (LU, 104) IX (IMID) , IX ( ILST ) , IY ( JLST ) ,IY( JLST) , 

E.  XCEND,YCEND,  RADI,  ANG3,ANG2,XP(  IMID) 

WRITE (LU, 104) IX (IFST) , IX ( IFST) , IY( JFST ), IY ( JMID) , 

E.  XCEND,Y(3:ND,  RADI,  ANG6,ANG5,YP(  JFST) 

WRITE (LU, 104) IX (IFST) , IX ( IFST) , IY ( JMID) , IY ( JLST) , 

E.  XCEND,  YCEND,  RADI,  ANG5,ANG4,YP(  JMID) 

WRITE (LU, 104) IX (ILST) , IX ( ILST) , IY ( JFST ), IY (JMID) , 

E.  XCEND,  YCEND,  RADI,  ANG8,ANG1,YP(  JFST) 

WRITE (LU, 104) IX (ILST) ,IX(ILST) ,IY ( JMID) , IY ( JLST ) , 

E.  XCEND ,  YCEND ,  RADI ,  ANGl ,  ANG2 ,  YP  ( JMID ) 

C-pd - Shuffle  lines - 


WRITE(LU,102)IX(IMID) ,IX{IMID) ,IY( JBEF) ,IY( JFST) , 
i  XL { IMID ) , YL ( JBEF ) , XL ( IMID ) , YCEND-RADl , YP ( JBEF ) 

WRITE (LU, 102) IX (IMID) , IX (IMID) , IY (JFST) ,IY(JMID) , 
k  XL ( IMID ), YCEND-RADl, XL (IMID) , YCEND, YP( JFST) 

WRITE (LU, 102) IX (IMID) , IX ( IMID ), IY ( JMID ) ,IY( JLST) , 
i  XL ( IMID ) , YCEND , XL ( IMID ) , YCEND+RADl , YP ( JMID ) 

WRITE (LU, 102) IX (IMID) , IX (IMID) ,IY( JLST) ,1Y( JAFT) , 

' ) , YCEND+RADl , XL ( IMID ) , YL ( JAFT ) , YP ( JLST ) 
, IX , IFST ) , IY ( JMID ) , IY ; JMID ) , 

' ) , YL ( JMID ) , XCEND-RADl , YL ( JMID ) , XP ( IBEF ) 


WRITE (LU 


XL (IMID) 
102)IX(IBEF) 
XL ( IBEF : 


UUU  U  U  OCJUUUOO 


WRITE(LU,102)IX(IPST) ,IX(IMID) ,IY( JMID) ,IY( JMID) , 

&>  XCEND-RADl ,  YL  ( JMID )  ,  XCEND ,  YL  ( JMID )  ,  XP  ( IFST ) 

WRITE (LU, 102) IX (IMID) ,IX(ILST) . lY {JMID ), lY ( JMID ) , 

&  XCEND , YL ( JMID ) , XCEND+RADl , YL ( JMID ) , XP ( IMID ) 

WRITE (LU, 102) IX (ILST) ,IX(IAPT) ,IY( JMID) ,IY( JMID) , 

S.  XCEND+RADl, YL(  JMID)  ,XL(IAFT)  ,yL(JMID)  ,XP(ILST) 

C 

CALL  WRTFI ( LU , IRX , IRY , IX , lY ) 

-pd - Fix  points  around  circle  and  certain  ones  inside - 

WRITE(LU,*) 

WRITE(LU,105)IX(1) ,IX(IRX+1) , lY ( 1 ) , lY ( JFST ) 

WRITE(LU,105)IX(1) ,IX(IFST) , lY { JFST) , IY( JLST ) 

WRITE ( LU,1 05 ) IX (ILST) ,IX(IRX+1) ,IY(JFST) ,IY{JLST) 
WRITE(LU,105)IX(1) ,IX(IRX+1) ,IY{JLST) ,IY(IRY+1) 

ISOL=4 

WRITE ( LU , 1 05 ) IX ( IFST ) +IS0L , IX ( ILST ) -ISOL , lY ( JFST ) , lY ( JLST ) 

WRITE ( LU , 1 05 ) IX ( IFST ) , IX ( ILST ) , lY ( JFST ) +IS0L , lY ( JLST ) -ISOL 

564  CONTINUE 

*********************************************************************** 

-pd - This  section  is  for  the  constant  cross  sectional  area  of  the - 

-  augmenter  tube.  This  cross  section  is  located  at  the  baclc - 

-  side  of  the  end  wall.  Two  options  exist,  one  for  a  circle - 

-  and  one  for  a  square. - 

ts 

DO  565  1*1,2 
C 

IX(1  )=1 

CALL  SETIV(IX,IG,220,1,NI) 

C 

XCENE=RG(47) 

YCENE*RG(48) 

RADl=RG(59)/2. 

DXI=(RADl*RADl/2. )**0.5 
IFST=IG(237 ) 

JFST=IG(257) 

IMID=IFST+1 

JMID=JFST+1 

ILST=IFST+2 

JLST*JFST+2 

IBEF=IFST-1 

JBEF=JFST-1 

IAFT=IFST+3 

JAFT=JFST+3 

C 

IRX=IG(48 ) 

IRY=IG(49 ) 

C 

XL{1  )=0.0 

CALL  SETRV(XL,"RG,340,1  ,NI) 

XL (IFST  )=XCENE-DXI 
XL(IFST+2 )=XCENE+DXI 
C 

LU=68  +  IGf  60 )+I 
IF(XL(IRX+1 ) .EQ.O.O)  THEN 
XDEL=RG(LU+10) 


XL  ( IRX-t-1 )  -XCENE-i-  ( XCENE-XDEL ) 

ENDIF 

CALL  SETRV(XP,RG,360,2,NI) 

C 

lYd  ).i 

CALL  SETIV(IY,IG,240,1  NI) 

c 

YL(1  )=0.0 

CALL  SETRV(YL,RG,380,1,NI) 

YL(JPST  )«YCENE-DXI 
YL ( JFST+2 ) «YCENE+DXI 

CALL  SETRV(YP,RG,400,2,NI) 

C 

CG(LU)='CS  ' 

I10=LU/10 

I1=LU-I10*10 

WRITE (CG(LU)  (3:3)  (II)  '  )  HO 
WRITE(CG(LU) (4:4) , ' (II)  '  )  H 

OPEN ( LU , FILE=CG ( LU ) , FORM= ' FORMATTED ' , STATUS* ' UNKNOWN ' ) 
IF(RG(LU+10) .NE.0.0)  XL( 1 )=RG(LU+10 ) 

CALL  WRTSQ ( LU , NX , NY , IRX , IRY , IX , lY , XL , YL , XP , YP ) 

C-pd - Overwrite  line  info  with  arc  data - 

ANG1=  0.0 
ANG2=  45.0 
ANG3=  90.0 
ANG4=135.0 
ANG5=180.0 
ANG6»225.0 
ANG7=270.0 
ANG8=315.0 
WRITE ( LU , * ) 

WRITE (LU, 104) IX (IFST) ,IX(IMID) ,IY(JFST) ,IY( JFST) , 

S.  XCENE.YCENE,  RADI,  ANG6,ANG7,XP(  IFST) 

WRITE ( LU, 104) IX (IMID) ,IX(ILST) ,IY (JFST ), lY ( JFST ) , 

£>  XCENE,YCENE,  RADI,  ANG7,ANG8,XP(  IMID) 

WRITE (LU, 104) IX (IFST) ,IX(IMID) ,IY( JLST) ,IY( JLST) , 

S.  XCENE,YCENE,RAD1,ANG4,ANG3,XP(IFST) 

WRITE (LU, 104) IX (IMID) ,IX(ILST) , lY (JLST ), lY ( JLST ) , 

&  XCENE,YCENE,RAD1,ANG3,ANG2,XP(IMID) 

WRITE(LU,104)IX(IFST) ,IX(IFST) ,IY(JFST) ,IY(JMID) , 

&  XCENE, YCENE, RADI, ANG6,ANG5,YP( JFST) 

WRITE ( LU, 104 ) IX ( IFST ), IX (IFST) ,IY(JMID) ,IY( JLST) , 

&  XCENE, YCENE, RADI, ANG5,ANG4,YP(JMID) 

WRITE(LU,104)IX(ILST) ,IX(ILST) ,IY(JFST) ,IY( JMID)  , 

S.  XCENE,YCENE,RAD1,ANG8,ANG1,YP(  JFST) 

WRITE ( LU, 104) IX (ILST) , IX ( ILST ) , lY ( JMID) ,IY( JLST) , 

&  XCENE , YCENE , RADI , ANGl , ANG2 , Y P ( JMID ) 

C 

C-pd - Shuffle  lines - 

WRITE (LU, 102) IX (IMID) ,IX(IMID) ,IY(JBEF) ,IY( JFST) , 

&  XL ( IMID ) , YL ( JBEF ) , XL ( IMID ) , YCENE-RADl , YP ( JBEF ) 

WRITE (LU, 102) IX (IMID) , IX ( IMID ), lY ( JFST ) ,IY( JMID) , 

&  XL ( IMID ) , YCENE-RADl , XL ( IMID ) , YCENE , YP ( JFST ) 

WRITE (LU, 102) IX (IMID) , IX (IMID) ,IY(JMID) .lY, JLST' , 

&  XL (IMID) , YCENE, XL (IMID) , YCENErRADl , Y? ( JMID ) 


oofiooo  no  o  nnn 


WRITE{LU,102)IX(IMID) ,IX(IMID) ,IY(JLST) ,IY(JAFT) , 

S.  XL  ( IMID )  ,  YCENE+RADl ,  XL  ( IMID )  ,  YL  ( JAFT )  ,  YP  { JLST ) 

WRITE(LU,102)IX(IBEF) ,IX(IPST) ,IY(JMID) ,IY(JMID) , 

S.  XL  ( IBEF )  ,  YL  ( JMID )  .  XCENE-RADl ,  YL  ( JMID )  ,  XP  ( IBEF ) 

WRITE(LU,102)IX(IFST) ,IX(IMID) ,IY( JMID) ,IY( JMID)  , 

&  XCENE-RADl , YL ( JMID ) , XCENE , YL ( JMID ) , XP ( IFST ) 

write (LU, 102) IX (IMID) ,IX{ILST) ,IY(JMID) ,IY( JMID) , 

St  XCENE ,  YL  ( JMID )  ,  XCENE+RADl ,  YL  ( JMID )  ,  XP  ( IMID  ) 

WRITE(LU,102)IX(ILST) ,IX(IAFT) ,IY(JMID) ,IY( JMID) , 

S.  XCENE+RADl, YL( JMID)  ,XL(IAPT)  ,YL(JMID)  ,XP(ILST) 

C 

CALL  WRTFI(LU,IRX,IRY,IX,IY) 

-pd - Fix  points  around  circle  and  certain  ones  inside - 

WRITE(LU,*) 

WRITE(LU,105)IX(1) ,IX(IRX+1) ,IY(1) ,IY(JFST) 
WRITE(LU,105)IX{1) ,IX(IFST) ,IY(JFST) ,IY(JLST) 

WRITE (LU, 105) IX (ILST) , IX ( IRX+1 ) , lY ( JFST ) , lY ( JLST ) 

WRITE(LU, 105 ) IX(1 ) ,IX(IRX+1) ,IY( JLST) ,IY(IRY+1) 

ISOL=4 

WRITE ( LU . 1 05 ) IX ( IFST ) +ISOL , IX ( ILST ) -ISOL , lY ( JFST ) , lY ( JLST ) 
WRITE ( LU , 105 ) IX ( IFST ) , IX ( ILST ) , lY ( JFST ) +ISOL , lY ( JLST ) -ISOL 

565  CONTINUE 

J1TMP=IY(JPST) 

J2TMP=IY( JLST) 

YDTMP=YL ( IRY ) 

YDTOP=YL(IRY+l) 


***■*!**■*!*  fe-kltifkit****************  ********************************  ********* 

-pd - This  section  is  for  the  exit  of  the  chimney.  Uniform  spacing — 

—  in  each  direction  is  assumed. - 

t6 

IX(1)=1 
IX(2)=NX+1 
C 

XL(1)=XL(1) 

XL(2)=XL(IRX+1) 

C 

XP(1)=1.0 

c 

IY(1)*1 

IY(2)=NY+1 

C 

YL(1)*RG(510+IG(537) ) 

YL(2)=RG(510+IG(537 )-l) 

C 

YP(1)=1.0 

C 

LU=71+IG(60) 

CG(LU)='CS  ' 

I10=LU/10 

I1=LU-I10*10 

WRITE(CG(LU)  (3:3)  ,  '  (II)  '  )  HO 
WRITE(CG(LU) (4:4) ,  '  (II)  '  )  II 

OPEN(LU,FILE=CG(LU) , FORM =' FORMATTED ' , STATUS =' UNKNOWN ' ) 


IRX*1 

IRY=1 

CALL  WRTSQ(LU,NX,NY,IRX,IRY,IX,iy,XL,YL,XP,yP) 

CALL  WRTFI ( LU , IRX , IRY , IX , lY ) 

C 

IF(IG(1) .EQ.O)  THEN 

WRITE (6,*)'  TOTAL  NUMBER  OF  GRID  INPUT  FILES  CREATED  =  ',LU-60 
WRITE ( 6 , * ) '  AT  THIS  POINT  USE  GGP  TO  CREATE  GRID  PLANES ' 

RETURN 

ENDIF 

C 

C 

2*********************************************************************** 
C* ********************************************************************** 

C-pd - Call  ggp - 

C 

C  INACTIVE 

C 

c 

c 

0************ *********************************************************** 
0*********************************************************************** 

c 

WRITE ( 6 , * ) '  CREATING  READCO  FILE' 

C 

C-pd - Stack  grids  (NOTE:  SFAC  hardwired  in  -  SATLIT  call  before - 

C conversions  set  in  Q1 ) - 

C 

SFAC=0.0254 
NI  =  25 

LMX=(NX+1)*(NY+1) 

CALL  SETIV(NZC,IG,510,3,NI) 

ZL(1  )=0.0 

CALL  SETRV(ZL,RG,510,1,NI) 

CALL  SETRV(ZP,RG,540,2,NI) 

CALL  SETIV(IZT,IG,540, 3,NI) 

CALL  SETIV(IZF1,IG,570,3,NI) 

CALL  SETIV(IZF2,IG,600,3,NI) 

C 

LUW1=88 

OPEN ( LUWl , FILE= ' gr id ' , FORM= ' FORMATTED ' , STATUS= ' UNKNOWN ' ) 

WRITE ( LUWl , 366 )NX+1 ,NY+1 ,NZ+1 

DO  5005  I=1,IG(501) 

IF(IZT(I) .EQ.l)  THEN 

CALL  XSTACK(CG(IZF1(I) ) ,LMX,NZC{ I) , ZL( I ) , ZL ( I+l ) , ZP ( I ) , 

&  XAS 1 , YAS 1 , Z ASL , SFAC , LUWl ) 

ELSEIF  (IZTd)  .EQ.2)  THEN 

CALL  XBLEND(CG(IZF1(I) ) ,CG(IZF2(I) ) ,LMX,NZC{I) ,ZL{I) ,ZL(I+1) , 

&  ZP(I) , XAS, YAS, XASl, YASl ,XAS2,YAS2,ZASL, SFAC, LUWl ) 

ELSEIF  (IZT(I) .EQ.3)  THEN 
ITRI=IG{9C ) 

ZPT=RG( 90  I 
NZC(I)=NZCiI)-ITRI 

CALL  XCURVE(CG(IZF1 (I) ) ,LMX,NZC(I) , ZL ( I ) , ZL ( I+l ) , ZP ( I ) ,YDTOP, 

S.  JITMP  ,  J2TMP ,  ITRI ,  ZPT ,  YAS  ,  ZAS  ,  XASl ,  YASl  ,  SFAC ,  LUWl  ) 

ELSEIF  (IZT(I) .EQ.4)  THEN 
ZCH=RG( 91 ' 

IF'ITOF.GT.ZCH)  WRITE; 6,*)'  ERROR:  EXIT  OF  CHIMNEY  LOWER  THAN 
&TOP  OF  ROOF  -->  CHECK  DATA  ' 


on  oo  n  o  n  no  oo  f  j  o  oo 


CALL  XLASTS(CG(IZP2(I) ) . LMX .NZC( I ) , ZCH, 

&  XAS,ZAS,XAS1 ,ZAS1,XAS2,ZAS2,YAS,YAS1 ,SPAC,LUW1 ) 

ELSE 

WRITE (6,*)'  ERROR  IN  STACKING  TYPE  ' 

ENDIP 

5005  CONTINUE 

CLOSE ( LUWl , STATUS = ' KEEP ' ) 

C 

RETURN 

C 

102  PORMAT( 'LI' ,4I3,F12.6,3P11.6,P7.2) 

103  PORMAT( 'PI' ,413) 

104  PORMAT( 'AR' ,4I3,F12.6,4P11.6,P7.2) 

105  FORMAT! 'FXY' 413 ) 

366  FORMAT! 315) 

-  GROUP  6.  Body-fitted  coordinates  or  grid  distortion 

6  CONTINUE 
RETURN 

-  GROUP  7 .  Variables  stored ,  solved  &  named 

7  CONTINUE 
RETURN 

- GROUP  8.  Terms  !  in  differential  equations)  £>  devices 

8  CONTINUE 
RETURN 

—  GROUP  9.  Properties  of  the  medixim  !or  media) 

9  CONTINUE 

IF!IG!1) .NE.3)  RETURN 

WRITE ! 6 , * )  '  CALCULATING  BOUNDARY  CONDITIONS ' 


-•od - Ambient - 

RGAS=RG!25) 

SC!1)=RG!1)/RG!21) 

SC!2)=RG!2)/RG!22) 

SC!3)=RG!3)/RG!23) 

SC!4)=RG!4)/RG!24) 

TEMP=RG!9) 

CALL  ENTHAL!TEMP,HSUM,CPSUM,SC.4,0) 

RG! 11 ) =CPSUM*RGAS*TEMP 

-pd - Engine - 

SC!1)»RG!5)/RG!21) 

SC!2)»RG!6)/RG!22) 

SC!3)=RG!7)/RG!23) 

SC!4)=RG!8)/RG!24) 

TEMP=RG!10) 

CALL  ENTHAL!TEMP,HSUM,CPSUM,SC,4,0) 

RG! 12 ) =CPSUM*RGAS*TEMP 
RETURN 

—  GROUP  10.  Inter-phase-transfer  processes  and  properties 

10  CONTINUE 
RETURN 

-  GROUP  11.  Initialization  of  variable  or  porosity  fields 

11  CONTINUE 
RETURN 


c 

r: - GROUP  12.  Convection  and  diffusion  adjustments 

12  CONTINUE 
RETURN 

C 

' - GROUP  13.  Boundary  conditions  and  special  sources 

13  CONTINUE 
RETURN 

Z -  GROUP  14.  Downstream  pressure  for  PARAB=.TRUE. 

14  CONTINUE 
RETURN 

2 - GROUP  15.  Termination  of  sweeps 

15  CONTINUE 
RETURN 

C -  GROUP  16.  Termination  of  iterations 

16  CONTINUE 
RETURN 

C -  GROUP  17.  Under-relaxation  devices 

17  CONTINUE 
RETURN 

C 

Z -  GROUP  18.  Limits  on  variables  or  increments  to  them 

18  CONTINUE 
RETURN 

n 

2 -  GROUP  19.  Data  communicated  by  satellite  to  GROUND 

19  CONTINUE 
RETURN 

2 GROUP  20.  Preliminary  print-out 

20  CONTINUE 
RETURN 

C - GROUP  21 .  Print-out  of  variables 

21  CONTINUE 
RETURN 

C -  GROUP  22.  Spot-value  print-out 

22  CONTINUE 
RETURN 

C 

n -  GROUP  23.  Field  print-out  and  plot  control 

23  CONTINUE 
RETURN 

C 

2 - GROUP  24 .  Diomps  for  restarts 

24  CONTINUE 

WRITE ( 6 , * ) '  OUT  OF  IT  ' 

RETURN 

END 

Q* ********************************************************************** 

SUBROUTINE  GCALE(GFACT) 

^*******************<r**************************** *********************** 

C  GCALE  gets  information  needed  to  scale  grid  points. 

C - 


INCLUDE  'satear' 

INCLUDE  'satloc' 

C  INCLUDE  ' bfcsat ' 

COMMON  F(l) 

C 

NI=NX+1 

NJ=NY+1 

NK=NZ+1 

JNNN=NI*NJ*NK 

CALL  SCALEW(F(KXC+1 ) .F(KYC+1 ) ,F(K2C+1 ) ,GFACT,JNNN) 

C 

RETURN 

END 

C 

Q*******r*************************<r***lHHHIt****H[*Xr************************ 

SUBROUTINE  SCALEW(X,Y,Z ,F,N) 

0******************************************** *************************** 
C  GCALEW  converts  grid  nodes  to  the  proper  units  (m). 

C - 

c 

DIMENSION  X(*),Y(*),2(*) 

C 

DO  1  1=1, N 
X(I)=X(I)*F 
Y(I)=Y(I)*F 
1  Z(I)=Z(I)*F 
C 

RETURN 

END 

C 

0*********************************************************************** 

SUBROUTINE  ENTHAL ( TEMP , HSUM , CPSUM , SC , NS , NFO ) 

^*********************************************** ******* ***************** 
w 

C  ENTHAL  calculates  H/RT  from  JANNAF  data.  The  order  of 
C  species  is  N  0  C  H. 

0 - 

C 

DIMENSION  SC ( 4 ) , ZS ( 7 , 2 , 4 ) 

DATA  ZS/  0.28532899E+01,  0 . 16022128E-02 ,  -0 . 629 3689 3E-06 , 

S<  0.11441022E-09,  -0 . 78057465E-14  ,  -0 . 89008093E+03  , 

S>  0.63964897E+01,  0 . 37044177E+01 ,  -0 . 14218753E-02  , 

E.  0.28670392E-05,  -0 . 12028885E-08  ,  -0 . 1 3954677E-1 3  , 

e.  -0.10640795E+04,  0 . 22336285E+01 , 

&  0.36122139E+01,  0 .74853166E-03 ,  -0 . 19820647E-06 , 

St  0. 33749008E-10,  -0 . 23907374E-14  ,  -0 . 11978151E+04  , 

St  0. 36703307E+01 ,  0 . 37837135E+01 ,  -0 . 3023  36  34E-02  , 

St  0.99492751E-05,  -0 . 98189101E-08  ,  0 . 33031825E-11 , 

St  -0.10638107E+04,  0 . 36416  345E+01 , 

St  0.44608041E+01,  0 . 30981719E-02  ,  -0 . 12392571E-05  , 

5.  0.22741325E-09,  -0 . 15525954E-1  3  ,  -0 . 48961442E+05  , 

St  -0.98635982E+00,  0 . 24007797E+01  ,  0 . 87350957E-02  , 

St  -0.66070878E-05,  0 . 20021861E-08  ,  0 . 6  32740  39E-1 5  , 

St  -0.48377527E+05,  0 . 96951457E+01  , 

St  0.27167633E+01  ,  0 . 29451 374E-02  ,  -0 . 80224374E-06  , 

6.  *  0.10226682E-09,  -0 . 48472145E-14 ,  -0.29905826E  05, 

St  0 . 66305671E+01 ,  0 . 40701275E+01 ,  -0 . 11084499E-02  , 

6.  0.41521180E-05,  -0 . 296  37404E-08  ,  0 . 80702103E-12  , 

6.  -0 . 30279722E+05  ,  -0 . 32270046E+00  / 


K=1 


IF(TEMP.LT.1000. )  K=2 
TEMP2=TEMP*TEMP 
HSUM=0 . 

CPSUM=0. 

DO  100  IS=1,NS 
CP1=ZS(1,K,IS) 

CP2=ZS(2,K,IS)*TEMP 

CP3=ZS( 3,K,IS)*TEMP2 

CP4=ZS ( 4 , K , IS ) *TEMP2*TEMP 

CP5=ZS ( 5 , K , IS ) *TEMP2*TEMP2 

CPSUM=CPSUM+SC( IS ) * ( CP1+CP2+CP3+CP4+CP5 ) 

100  HSUM  =HSUM+ 

1  SC( IS ) * ( CP1+ . 5*CP2+ .  333  3  3*CP3+ . 25*CP4+ . 2*CP5+ZS ( 6 ,K , IS ) /TEMP ) 

RETURN 

END 

^ieic'kicic'k'k'k'k'k'k'kicic'kic'kicicitic'kicie^ic'k'kicicicicieicicic'k'k’kic'k'k'k’kic'kicicie'kicie'kicic'kic'kieicieiiicic'k'kicie’kic-k 

SUBROUTINE  SETI V ( lA , IG , IFST , ITY , NI ) 

’*************************************★*★*****************************★* 
J  SETIV  places  integer  values  from  the  IG  array  into  the 
C  proper  local  array. 


DIMENSION  IA(*),IG(*) 

r* 

IF(ITY.EQ.l)  THEN 
DO  1  1  =  1, NI 

1  IA(I+1)=IG(IFST+I)+1 
ELSEIF  (ITY.EQ.2)  THEN 

DO  2  1=1, NI 

2  IA(I)=IG(IFST+I)+1 
ELSEIF  (ITY.EQ.3)  THEN 

DO  3  1=1, NI 

3  IA(I)=IG(IFST+I) 

ELSE 

WRITE ( 6 , *  )  '  ERROR  SETIV - INVALID  TYPE  ' 

ENDIF 

C 

RETURN 

END 

C 


SUBROUTINE  SETRV ( RA , RG , IFST , ITY , NI ) 

q;************* *************************************************** ******* 

C  SETRV  places  real  values  from  the  RG  array  into  the  proper 
:  local  array. 


DIMENSION  RA(*),RG(*) 

IF(ITY.EQ.l)  THEN 
DO  1  1=1, NI 

1  RAf I+l ) =RG(IFST+I ) 

ELSEIF  (ITY.EQ.2)  THEN 

DO  2  I=1,NI 

2  RA(I )=RG(IFST+I ) 

ELSE 

WRITE; 6, *r  ERROR  SETRV  -  INVALID  TYPE 

ENDIF 


c 

RETURN 

END 

C 

0*  *************  5*r  ***********************  it  *******************************  * 

SUBROUTINE  WRTSO( LU ,NX .NY , IRX , IRY . IX , lY , XL , YL , XP , YP ) 
0*********************************************************************** 
C  WRTSQ  writes  input  grid  file  assuming  all  straight  lines. 

C - 

c 

DIMENSION  IX(*) ,IY(*) ,XL(*) ,YL(*) ,XP(*) ,YP(*) 

C 

WRITE (LU, 100)  NX+1 
WRITE(LU,101 )  NY+1 
DO  10  I=1,IRY+1 
WRITE(LU,*) 

DO  10  J=1,IRX 
10  WRITE(LU,102) 

E<  IX(  J)  ,IX(  J+1)  ,IY(I)  ,IY(I)  ,XL(J)  ,YL(I)  ,XL{J+1)  ,YL{I)  ,XP(J) 

DO  20  I=1,IRX+1 
WRITE (LU,*) 

DO  20  J=1,IRY 
20  WRITE(LU,102) 

&  IX(I) ,IX(I) ,IY( J) ,IY(J+1 ) ,XL(I) .yL{ J) ,XL(I) ,YL( J+1 ) ,YP( J) 

100  FORMAT ( ' IMAX ' , 1 3 ) 

101  FORMAT ( 'UMAX' ,13) 

102  FORMAT ( 'LI' , 41 3 , F12 . 6 , 3F11 . 6 , F7 . 2 ) 

C 

RETURN 

END 

C 

0******* ******************************************************* ********* 
SUBROUTINE  WRTFI ( LU . IRX , IRY . IX , lY ) 

0** *********************************************************** ********** 
C  WRTFI  writes  commands  needed  to  fill  subsections. 

0 - - - 

C 

DIMENSION  IX ( *  )  , lY ( *  ) 

C 

DO  10  1=1, IRY 
WRITE(LU,*) 

DO  10  J=1,IRX 

10  WRITE (LU, 103 )IX(J) , IX (J+1) , lY ( I ) , lY ( I+l ) 

C 

103  FORMAT( 'FI' ,413) 

C 

RETURN 

END 

0^3^-*?f**'******-****:*:*********************1t*************:*r****************** 

SUBROUTINE  WRTFI 2 ( LU , IRX , IRY , IX , I Y , IF , JF ) 
0*********************************************************************** 
C  WRTFI  writes  commands  needed  to  fill  subsections. 

0 - 

C 

DIMENSION  IX(*) ,iy(*) 

r* 

WRITE (LU,*) 


n  (.  n ..  o  o  ..  o  ..  .JO 


DO  10  J=1,IRX 

IF( (I.EQ.JF.OR.I.EQ.JF+1) .AND. (J.EQ.IF.OR.J.EQ.IF+l ) )  GOTO  10 
WRITE (LU, 103 )IX(J) , IX ( J+1 ) , lY ( 1) , lY { I+l ) 

10  CONTINUE 
C 

103  FORMAT{ 'FI' ,413) 

RETURN 

END 

j********************************************************************  *  ** 

SUBROUTINE  XSTACK ( FIPRE , LMX , NZC , ZFST , ZLST , ZP , XI , Y1 , ZL , CV , LUWl ) 
}*********************************************<:************************* 

:  XSTACK  repeats  one  computational  grid  file 


CHARACTER*4  FIPRE, FEXT 
CHARACTER* 8  FINAME 
DIMENSION  XI ( * ) , Yl ( * ) , ZL ( * ) 

FEXT= ' . GRD ' 

F1NAME=F1PRE//FEXT 

LUR1=80 

OPEN ( LURl , FILE=F1NAME , FORM* ' FORMATTED ' , STATUS* ' OLD ' ) 

READ{LUR1 , 366 )LP1 ,MP1 ,NTP1 

READ(LUR1,333) ( (Xl(IJ) , IJ=I , LMX,LP1 ) , 1=1 , LPl ) 

READ(LUR1,333  )  (  (YKU)  ,  IJ=I  ,LMX,  LPl )  ,  1=1 ,  LPl ) 

READ(LUR1,333) ( (ZTEMP,  IJ=I ,LMX,LP1 ) , 1=1 ,LP1 ) 

CALL  ZLSET ( ZL , 1 , NZC+1 , ZFST , ZLST , ZP ) 

DO  10  K=1,NZC 

WRITE( LUWl, 333) ( (XI ( IJ ) *CV, IJ=I , LMX, LPl ) ,1=1, LPl ) 

WRITE(LUW1,333) ( (Y1(IJ)*CV,IJ=I,LMX.LP1) ,I=1,LP1) 

WRITE ( LUWl , 3 3 3 ) ( (ZL(K)*CV,  IJ=I,LMX,LP1) ,1=1, LPl) 

10  CONTINUE 

CLOSE ( LURl , STATUS* ' KEEP ' ) 

RETURN 

333  F0RMAT(5(1P,E13.6) ) 

366  FORMAT (315) 

END 

*********************************************************************1^ 
SUBROUTINE  XBLEND ( FIPRE , F2PRE , LMX , NZC , ZFST , ZLST ,ZP,X,y,Xl,yi, 

&  X2,Y2,ZL,CV,LUW1 ) 

*************************#r*************************^*****5»r**********  =  * 

XBLEND  blends  two  computational  grids  files 


CHARACTER* 4  FIPRE , F2PRE , FEXT 
CHARACTER* 8  FINAME , F2NAME 

DIMENSION  X(2500),Y(2500) , XI (2500) , Yl ( 2500 ) , X2 ( 2500 ) , 12 ( 2 500  )  , 
S.  ZL(IOO) 

FEXT* ' ,GRD' 

F1NAME=F1PRE//FEXT 
F2NAME=F2PRE/ /FEXT 
LUR1=80 


LUR2=01 

OPEN ( LURl , FILE=F1NAME , FORM* ' FORMATTED ' , STATUS* ' OLD ' ) 

OPEN ( LUR2 , FILE=F2NAME , FORM* ' FORMATTED ' , STATUS* ' OLD ' ) 

C 

READ (LURl, 366 )LP1,MP1,NTP1 

READ(LUR1 , 333 ) ( (Xl(IJ) , IJ*I , LMX ,LP1 ) ,I=1,LP1) 

READ (LURl , 333) ( ( Y1 ( IJ ) . IJ=I , LMX . LPl ) , 1=1 , LPl ) 

READ(LUR1, 333) ( (ZTEMP,  IJ=I , LMX,LP1 ) , 1=1 , LPl ) 

READ (LUR2, 366) LPl, MP1,NTP1 

READ(LUR2,333) ( ( X2 ( IJ ) , IJ=I ,LMX ,LP1 ) , 1=1 , LPl ) 

READ(LUR2,333) ( (Y2(IJ) ,IJ*I ,LMX,LP1 ) ,1*1 ,LP1 ) 

READ(LUR2,333) ( (ZTEMP,  IJ=I ,LMX,LP1 ) , 1=1 , LPl ) 

C 

CALL  ZLSET(ZL,1,NZC+1,ZFST,ZLST,ZP) 

C 

DO  20  K=1,NZC 
DO  21  1=1 , LMX 
IF(NZC.EQ.l)  THEN 
X(I)=X1(I) 
y(I)=Yl(I) 

ELSE 

X(I )=X1 (I )*FLOAT(N2C-K+l )/FLOAT(NZC)+ 

E<  X2(I)*FLOAT(K-l)/FLOAT(NZC) 

Y ( I ) =Y1 ( I ) *FLOAT ( NZC-K+ 1 ) /FLOAT ( NZC ) + 

Gc  Y2(I)*FLOAT(K-l)/FLOAT(NZC) 

ENDIF 

21  CONTINUE 

WRITE (LUWl, 333) ( ( X ( IJ ) *CV, IJ=I , LMX ,LP1 ) , 1=1 . LPl ) 

WRITE(LUW1, 333) ( ( Y ( IJ ) *CV, IJ=I ,LMX,LP1 ) , 1=1 , LPl ) 

WRITE(LUW1,333) ( (ZL(K)*CV,IJ=I,LMX,LP1) ,I=1,LP1) 

20  CONTINUE 

CLOSE ( LURl , STATUS* ' KEEP ' ) 

CLOSE ( LUR2 , STATUS* ' KEEP ' ) 

C 

RETURN 

333  F0RMAT(5(1P,E13.6) ) 

366  FORMAT (315) 

END 

C 

QH  tut********************************** ************************** ******** 

SUBROUTINE  XCURVE ( FIPRE , LMX , NZC , ZFST , ZLST , ZP , CENC , NY2 , NY 3 , ITRI , 

G>  ZPT,Y,Z,X1,Y1,CV,LUW1) 

Q*********************************************************************** 

C  XCURVE  creates  the  grid  in  the  augmenter  tube  bend  section 

C - 

c 

CHARACTER* 4  F1PRE,FEXT 
CHARACTER *8  FINAME 
.DIMENSION  Y ( * ) , Z ( * ) , XI ( * ) , Y1  (  * ) 

FEXT= ' . GRD ' 

F1NAME=F1PRE//PEXT 

LUR1=80 

C-pd - NZC  number  of  cells  in  bend  '  (WARNING:  Must  be  even) - 

C---  NYl  lower  Y  line - 

C NY2  lower  Y  circle  line - 

C NY3  upper  Y  circle  line - 

C -  NY5  upper  Y  line - 

OPEN (LURl , FI LE=F1NAME, FORM* 'FORMATTED' , STATUS* ' OLD ' ) 


READ (LURl, 366 )LP1,MP1,NTP1 

READ(LUR1 , 333 ) ( (XI (IJ) .IJ=I ,LMX,LP1 ) ,1=1 ,LP1 ) 
READ( LURl, 333) ( (Yl (IJ) ,IJ=I,LMX,LP1 ) ,I=1,LP1) 
READ(LUR1 , 333 ) ( ( ZTEMP  , IJ=I ,LMX,LP1 ) ,I=1,LP1) 

C 

NY1  =  1 
NY5=MP'l 
C 

0-pd - Do  Boundary - 

WRITE ( LUWl , 3 3 3 ) ( ( XI ( IJ ) *CV , IJ=I ,LMX, LPl ) ,I=1,LP1) 
WRITE ( LUWl , 3 3 3 ) ( ( Yl ( IJ ) *CV , IJ=I ,LMX, LPl ) , 1=1 , LPl ) 
WRITE ( LUWl , 3 3 3 ) ( (ZFST*CV,  IJ=I,LMX,LP1 ) ,1=1, LPl) 

% 

:-pd - Do  straight  section  of  pipe - 

DO  100  IP=1,ITRI 
DELZ=ZPT»FLOAT ( IP ) /ITRI 

t 

DO  105  J=1,MP1-1 
DO  105  1=1, LPl 
LOC=( J-1)*LP1+I 
105  Y(L0C)=Y1 (LOG) 

C 

DO  110  1=1, LPl 
L0C=(MP1-1)*LP1+I 
110  Y ( LOG ) =Y1 ( LOG ) +0 . 001*FLOAT( IP ) 

DO  115  J=1,NY3 
DO  115  1=1, LPl 
LOG=(J-l)*LPl-rI 
115  Z(LOG)=ZFST+DELZ 

f 

YFST=Y1(NY3*LP1) 

YLST=Y1(MP1*LP1) 

DO  120  J=NY3+1,MP1 
DO  120  1=1, LPl 
LOG=( J-1 )*LP1+I 
YLOG=Yl ( J*LP1 ) 

YFGT= 1 . 0- ( YLOG-YFST ) / ( YLST-YFST ) 

120  Z (LOG)=ZFST+DELZ*YFGT 

WRITE (LUWl , 333 ) ( ( XI ( IJ ) *GV , I J=I ,LMX, LPl ) , 1=1 ,LP1 ) 
WRITER LUWl, 333) ( (Y(IJ)*GV,  IJ=I ,LMX,LP1 ) ,1=1, LPl) 
WRITE (LUWl, 333) ( (Z(IJ)*GV,  IJ=I,LMX,LP1 ) ,1=1 ,LP1 ) 
100  GONTINUE 
G 

G-pd - Do  curve  section - 

ZFST=ZFST+ZPT 

ZLEN=ZLST-ZFST 

DO  400  IP=1,NZG 

ANG=90 . 0 /FLOAT ( NZG ) * FLOAT ( IP ) 

PI=3 . 141592654 

RAD=ANG/360.*2.*PI 

YFAG=GOS(RAD) 

C-pd - Lower  Y  row - 

DO  205  1=1, LPl 
IF(IP.LE.NZG/2)  THEN 
Y(I)=0.0 
ELSE 

Y ( I ) =FLOAT  f ; ?- ( NZG/ 2 )  ) /FLOAT ( NZC/ 2 ) *GENC 


ENDIF 

205  CONTINUE 
C 

C-pd - Lower  Y  circle  row - 

IAD=(NY2-1 )*LP1 
DO  210  1=1, LPl 

Y ( lAD+I ) =yi ( IAD+1 )  +  { 1 . 0-YFAC) * ( CENC-Yl ( lAD+I ) ) 

210  CONTINUE 
C 

C-pd - Upper  Y  circle  row - 

IAD=(NY3-1 )*LP1 
DO  215  1=1, LPl 

Y ( lAD+I ) =Y1 ( lAD+I ) + ( 1 . 0-YFAC ) * (CENC-Yl ( lAD+I ) ) 

215  CONTINUE 
C 

C-pd - Upper  Y  row - 

IAD=(MP1-1 )*LP1 

XFUG=( { FLOAT (IP) /FLOAT (NZC) ) *0 . 01 ) + ( 0 . 001*FLOAT ( ITRI ) ) 
DO  220  1=1, LPl 

C-od - add  fact  to  give  a  north  cell  area - 

Y ( lAD+I ) =Y1 ( lAD+I ) +XFUG 
220  CONTINUE 
C 

C-od - Fill  first  section - 

DO  250  J=2,NY2-1 
DO  250  1=1, LPl 
LOC=( J-1 )*LP1+I 
IAD1=0 

IAD2=(NY2-1)*LP1 

Y(LOC)=Y(IADl+I)+( (Y1(L0C)-Y1(IAD1+I) )/ 

+  (Y1(IAD2+I)-Y1(IAD1+I) ) * ( Y ( IAD2+I ) -Y ( lADl+I ) ) ) 

250  CONTINUE 
C 

C-pd - Fill  circle  section - 

DO  260  J=NY2+1 ,NY3-1 
DO  260  1=1, LPl 
LOC=( J-1 )*LP1+I 
IAD1=(NY2-1)*LP1 
IAD2=(NY3-1 )*LP1 

Y(LOC)=Y(IADl+I)+( (Yl(LOC)-Yl(IADl+I) )/ 

+  (yi(IAD2+I)-Yl(IADl+I) )*(Y(IAD2+I)-y(IADl+I) ) ) 

260  CONTINUE 
C 

C-pd - Fill  top  section - 

DO  270  J=NY3+1,MP1-1 
DO  270  1=1, LPl 
LOC=( J-1)*LP1+I 
IAD1=(NY3-1)*LP1 
IAD2=(MP1-1)*LP1 

Y(LOC)=Y(IADl+I)+( (yi(LOC)-yi(IADl+l) )/ 

+  (Y1(IAD2+I)-Y1(IAD1+I) ) * ( Y ( IAD2+I ) -Y ( lADl+I ) ) ) 

270  CONTINUE 

r> 

w 

C 

ZD4  =  0.0 
C 

C-pd - Lower  Z  row - 

ZFAC=SIN(RAD) 

DO  305  1=1, LPl 

IF( IP.LE.NZC/2 )  THEN 


Z ( I ) =FLOAT ( IP ) /FLOAT (NZC/2 ) *ZLEN+ZFST 
ELSE 

Z(I)=ZLEN+ZFST 

ENDIF 

305  CONTINUE 

:-pd - Lower  Z  circle  row - 

IAD=(NY2-1)*LP1 
DO  310  1=1, LPl 

Z ( lAD+I ) =SIN ( RAD ) * ( CENC- Y1 ( lAD+I ) ) +2FST 
310  CONTINUE 
C 

:-pd - Upper  Z  circle  row - 

IAD=(NY3-1)*LP1 
DO  315  1=1, LPl 

Z ( lAD+I ) =SIN ( RAD ) * ( CENC- Y1 ( lAD+I ) ) +ZFST 
315  CONTINUE 
C 

C-pd - Upper  Z  row - 

IAD=(MP1-1)*LP1 
DO  320  1=1, LPl 
Z ( lAD+I ) =ZD4+ZFST-ZPT 
320  CONTINUE 

C-pd - Fill  first  section - 

DO  350  J=2,NY2-1 
DO  350  1=1, LPl 
LOC=(J-l)*LPl+I 
IAD1=0 

IAD2=(’NY2-1;*LP1 

Z(LOC)=Z(IADl+I)-( (Yl(LOC)-Yl(IADl+l) )/ 

+  ( Y1 ( IAD2+I ) -Y1 ( lADl+I ) ) * ( Z ( lADl+I ) -Z ( IAD2+I ) ) ) 

350  CONTINUE 

C-od - Fill  circle  section - 

DO  360  J=NY2+1,NY3-1 
DO  360  1=1, LPl 
LOC= ( J-1 )*LP1+I 
IAD1=(NY2-1 )*LP1 
IAD2=(NY3-1)*LP1 

Z(LOC)=Z(IADl+I)-( (Yl{LOC)-Yl(IADl+I) )/ 

+  (Y1(IAD2+I)-Y1(IAD1+I) ) * ( Z ( lADl+I ) -Z ( IAD2+I ) ) ) 

360  CONTINUE 

C-pd - Fill  top  section - 

DO  370  J=NY3+1,MP1-1 
DO  370  1=1, LPl 
LOC=( J-1)*LP1+I 
IAD1={NY3-1)*LP1 
IAD2=(MP1-1 )*LP1 

Z(LOC)=Z(IADl+I)-( (Yl{LOC)-Yl(IADl+I) )/ 

+  (Y1(IAD2  +  I)-Y1(IAD1  +  I) ) * ( Z ( lADl+I ) -Z ( IAD2  +  I ) )  ) 

370  CONTINUE 

C-pd - Write  data - 

WRITE ( LUWl , 3 3 3 ) ( ( XI ( IJ ) *CV , IJ=I ,LMX , LPl ) ,1=1, LPl) 

WRITE ( LUWl , 333) ( (Y(IJ)*CV,  I J=I ,LMX , LPl ) ,1=1, LPl) 

WRITE ( LUWl , 3 3 3 ) ( (Z(IJ)*CV,  I J=I , LMX , LPl ) , 1=1, LPl ) 

400  CONTINUE 


o  o  o  nan 


CLOSE ( LURl , STATUS* ' KEEP ' ) 

C 

RETURN 

C 

333  F0RMAT(5{1P,E13.6) ) 

366  FORMAT (315) 

C 

END 

C 

0************Tlt****  *************************************  ***************** 

SUBROUTINE  XLASTS ( FIPRE , LMX , NZC , YC , 

S.  X,Zl,Xl,Z,X2,Z2,yi,Y,CV,LUWl) 

c***  ********‘**  *"^***********11**  ***it*iiic**-k*1c*'k**icic**1clt  ********  it** -kiciddfitit** 

XLASTS  creates  the  grid  in  the  last  section 


CHARACTER* 4  FIPRE, F2PRE,FEXT 
CHARACTER *8  FINAME 

DIMENSION  X{*)  ,Z(*) ,X1(*) ,Z1{*) ,X2(*) ,Z2(*) ,Y1(*) ,Y(*) 

FEXT= ' . GRD ' 

FINAME = FI PRE/ / FEXT 
LUR1=80 

-pd - Do  last  section  (blend) - 

OPEN ( LURl , FILE=F1NAME , FORM* ' FORMATTED ' , STATUS* ' OLD ' ) 

READ (LURl, 366 )LP1,MP1,NTP1 

READ( LURl, 333) ( ( X2 ( IJ ) , IJ*I , LMX ,LP1 ) , 1=1 , LPl ) 

READ(LUR1,333) ( (52 ( IJ ) , IJ*I , LMX ,LP1 ) , 1=1 , LPl ) 

READ(LUR1,333) ( ( ZTEMP  ,IJ=I ,LMX,LP1 ) ,1=1 ,LP1 ) 

DO  440  K=2,NZC+1 
DO  441  1*1, LMX 
IF(NZC.EQ.l)  THEN 
X(I)*X1(I) 

Z(I)=Z1(I) 

ELSE 

X ( I ) *X1 ( I ) *FLOAT ( NZC-K+1 ) /FLOAT ( NZC ) + 

S.  X2(I)*FLOAT(K-l)/FLOAT(NZC) 

Y ( I ) =Y1 ( I ) *FLOAT ( NZC-K+1 ) /FLOAT ( NZC ) + 

G.  YC*FLOAT(K-l ) /FLOAT  (NZC) 

Z ( I ) =Z1 (I ) *FLOAT( NZC-K+1 ) /FLOAT (NZC )+ 

&  Z2(I)*FLOAT(K-l)/FLOAT(NZC) 

ENDIF 

441  CONTINUE 

WRITE (LUWl,  333) ( ( X ( I J ) *CV , IJ=I , LMX , LPl )  ,1*1, LPl) 

WRITE (LUWl , 333) ( ( Y ( IJ ) *CV , IJ=I , LMX, LPl ) ,1*1, LPl) 

WRITE ( LUWl , 333 ) ( ( Z ( IJ ) *CV , I J=I , LMX , LPl ) ,1*1, LPl) 

440  CONTINUE 

CLOSE ( LURl , STATUS* ' KEEP ' ) 

O 

w 

RETURN 

333  F0RMAT(5(1P,E13.6) ) 

366  FORMAT(3I5) 

END 

C 

0* ********************************************************************** 

SUBROUTINE  ZLSET ( ZBND , INDEXl , INDEXL . Z1 , ZL , PWR ) 

0* ********************************************************************** 
r' 

C  (C)  COPYRIGHT  1991  DOC  D  of  North  America,  Inc.  ALL  RIGHTS  RESERVED 


CJ  C.  >  U 


Read  input  parameters  to  distribute  a  number  of  points  along  a 
line  segment. 

Syntax  is  :  LINE  Ki  KL  Zl  ZL  APWRA 


DIMENSION  ZBND(*) 

IF(PWR.GT.O)  THEN 
K1=INDEX1 
KL=INDEXL 
INC=1 

DELZ  *  ZL-Zl 
ZF  =  Zl 
ELSE 

K1=INDEXL 

KL=INDEX1 

INC=-1 

DELZ  *  Zl-ZL 
ZF  =  ZL 
PWR=ABS(PWR) 

ENDIF 

DO  10  I  =  K1,KL,INC 

RAT  =  ( FLOAT (I-Kl) /FLOAT { KL-Kl ) )**PWR 
ZBND(I)  =  ZF  +  DELZ*RAT 
10  CONTINUE 

RETURN 

END 


APPENDIX  D 


J  FILE  NAME  GROUND. FTN - 

C  THIS  IS  THE  MAIN  PROGRAM  OF  EARTH 


22  April  87 


:  (C)  COPYRIGHT  1984,  LAST  REVISION  1987. 

C  CONCENTRATION  HEAT  AND  MOMENTUM  LTD.  ALL  RIGHTS  RESERVED. 

C  This  subroutine  and  the  remainder  of  the  PHOENICS  code  are 
:  proprietary  software  owned  by  Concentration  Heat  and  Momentum 

J  Limited,  40  High  Street,  Wimbledon,  London  SW19  5AU,  England. 


:  PROGRAM  MAIN 

C 

C  1  The  following  two  COMMON'S,  which  appear  identically  in  the 
:  satellite  MAIN  program,  allow  up  to  80  dependent  variables  to 

C  be  solved  for  (or  their  storage  spaces  to  be  occupied  by 

C  other  variables,  such  as  density).  If  a  larger  number  is 

1  required  increase  the  parameter  nvd.  Less  than  50  for  nvd  is  not 

2  permitted. 

C 

-  If  more  patches  are  required  increase  npatd. 

C  If  a  larger  F-array  is  needed  increase  nfd . 

n 

PARAMETER  (NVD=80 ,NFD=18000000 ,NPATD=1000 ) 

COMMON/LGE4/L4 (NVD) 

1/LDB1/L5{NVD)/IDA1/I1(NVD)/IDA2/I2(NVD)/IDA3/I3 (NVD)/IDA4/I4{NVD) 
1/IDA5/I5(NVD)/IDA6/I6(NVD)/GI1/I7(NVD)/GI2/I8(NVD)/HDA1/IH1  (NVD) 
1/GH1/IH2  ( NVD )  /RDAl/Rl  (NVD )  /RDA2/R2  (NVD )  /RDA3/R3  ( NVD )  /RDA4/R4  ( NVD  ) 
1  /RDA5/R5  ( NVD )  /RDA6/R6  ( NVD )  /RDA7  /R7  ( NVD )  /RDA8/R8  ( NVD )  /RDA9  /R9  ( NVD  ) 
1 /RDAl 0 /R1 0 ( NVD ) /RDAl 1 /R1 1 ( NVD ) 

1 /GRl /R1 2  ( NVD ) /GR2/R1 3  ( NVD ) /GR3/R14  ( NVD ) /GR4 /R1 5  ( NVD ) 

1/IPIPl/IPl  ( NVD )  /HP1P2/IHP2  ( NVD )  /RPIPl/RVAL  ( NVD )  /LPIPl /LVAL  ( NVD ) 
1/IFPL/IPLO(NVD)/RFPL1/ORPRIN(NVD)/RFPL2/ORMAX(NVD) 

1 /RFPL  3 /ORMIN ( NVD ) 

LOGICAL  LI , L2 , L  3 , L4 , L5 , DBGFIL , LVAL 
CHARACTER*4  IHl , IH2 , IHP2 ,NSDA 

COMMON/FO 1/19(4  *NVD ) 

COMMON/DISC/DBGFIL 
COMMON/LUNITS/LUNIT ( 60 ) 

EXTERNAL  WAYOUT 
C 

:  2  Set  dimensions  of  data-for-GROUND  arrays  here.  WARNING:  the 
J  corresponding  arrays  in  the  MAIN  program  of  the  satellite 
C  (see  SATLIT)  must  have  the  same  dimensions. 

COMMON/LGRND/LG( 1000 ) /IGRND/IG( 1000 ) /RGRND/ RG ( 1 0000 ) 
COMMON/CGRND/CG( 1000 ) 

LOGICAL  LG 
CHARACTER* 4  CG 

J  3  Set  dimensions  of  data-for-GREX2  arrays  here.  WARNING:  the 
C  corresponding  arrays  in  the  MAIN  program  of  the  satellite 
'see  SATLIT)  must  have  the  same  dime-'isions . 

COMMON/LSG/LSGD ( 20 ) /ISG/ I3GD ( 20 ) /RSG/RSGD (10  0) /CSG/CSGD  a  0 ; 
LOGICAL  LSGD 
CHARACTER* 4  CSGD 

C  4  Set  dimension  of  patch-name  array  here.  WAK.NING:  the  array 

r  NAMPAT  in  rhe  MAIN  program  of  the  satellite  must  have  the 


dimension. 

COMMON/NPAT/NAMPAT ( NPATD ) 
CHARACTER *8  NAMPAT 


:  CONFIG  PILE  name  declaration. 

COMMON / CNFG/ CNFI G 
CHARACTER  CNFIG*48 

;  5  The  numbers  in  the  next  two  statements  (which  must  be  ident- 

:  ical)  indicate  how  much  computer  memory  is  to  be  set  aside 

::  for  storing  the  main  and  auxiliary  variables.  The  user  may 

2  alter  them  if  he  wishes,  to  accord  with  the  number  of 

2  grid  nodes  and  dependent  variables  he  is  concerned  with. 

COMMON  F(NFD) 

NFDIM=NFD 

Z  6  Logical-unit  numbers  and  file  names,  not  to  be  changed. 

CALL  CNFGZZ(2) 

CALL  EARSET ( 1 ) 

CALL  OPENFL(6) 

3  User  may  here  change  message  transmitted  to  logical  unit 
U  LUPR3 

CALL  WRIT40{ 'Ground-Station  is  ground, f,  09/25/87.  ') 

CALL  MAIN1{NFDIM) 

CALL  WAYOUT(O) 

STOP 

END 

^*  ***»**•★  *  )>r  ****************************************************  * 

SUBROUTINE  GROSTA 

INCLUDE  'satear' 

INCLUDE  'grdloc' 

INCLUDE  'grdear' 

C.  .  .  .  This  subroutine  directs  control  to  the  GROUNDS  selected  by 
C  the  satellite  settings  of  USEGRX,  NAMGRD  &  USEGRD. 

C  Subroutine  GREX2  contains  options  for  fluid  properties, 

C  turbulence  models,  wall  functions,  chemical  reaction  etc.  It 
C  was  introduced  in  version  1.4  of  PHOENICS. 


IF (USEGRX)  CALL  GREX2 

BTSTGR  contains  the  sequences  used  in  conjunction  with 
the  BFC  test  battery. 

IF ( NAMGRD. EQ. 'BTST' )  CALL  BTSTGR 

TESTGR  contains,  test  battery  seqi’ences  used  in  conjunction 
with  the  test-battery  SATLIT  subrouti.ne,  TE3TST. 

I F ( NAMGRD . EQ . ' TEST ' )  CALL  TESTGR 


SPECGR  IS  a  generic  "special"  GROUND  che  name  of  which  can 
be  used  by  anyone  for  their  own  purposes,  SPCIGR,  SPC2GR  and 
SPC3GR  permit  the  user  to  attach  his  own  licrary  of  special 
GROUNDS  selected  according  to  the  prescription  of  NAMGRD. 

IF ( NAMGRD. EQ. 'SPEC' ;  CALL  SPECGR 


C. . . .  The  subroutine  GROUND  arrached  to  the  bottom  of  this  file  Is 
T  an  unallocated  blank  form  Into  which  the  user  can  Insert  his 
;  own  FORTRAN  sequences.  The  PIL  parameter  USEGRD  governs  entry 
C  In  to  It. 

C 

IF (USEGRD)  CALL  GROUND 
>  • 

C. . . .  The  data  echo  Is  called  at  the  preliminary  prlnt-out  stage. 
IF(IGR.NE.20)  RETURN 
IF( .NOT. ECHO)  GO  TO  20 

CALL  DATPRN(Y.Y,y,Y,  Y,Y,Y,Y,  Y,Y,Y,N,  Y,Y,Y,Y. 

&  Y,Y,Y,Y,  Y,Y,Y,Y) 

RETURN 

20  CALL  DATPRN(Y,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N) 
RETURN 
END 

SUBROUTINE  SPECGR 

CALL  WRIT40( 'DUMMY  SUBROUTINE  SPECGR  CALLED.  ') 

CALL  WRIT40( 'PLEASE  ATTACH  SPECGR  OBJECT  AT  LINK.  ') 

CALL  WAYOUT(2) 

RETURN 

END 

SUBROUTINE  QUIZ 

RETURN 

END 

^*  *★*★****★★*★*  Jlf  **★★*★***★**  *****  It  **  *************  **★**★★★★  * 

SUBROUTINE  GROUND 
C 

INCLUDE  'satear' 

INCLUDE  'grdloc' 

INCLUDE  'grdear' 

CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  USER  SECTION  STARTS: 

Z  1  Set  dimensions  of  data-for-GROUND  arrays  here.  WARNING:  the 
C  corresponding  arrays  in  the  MAIN  program  of  the  satellite 

C  and  EARTH  must  have  the  same  dimensions. 

COMMON/LGRND/LG( 1 000 ) /IGRND/IG( 1000 ) /RGRND/RG( 10000 ) 
COMMON/CGRND/CG(1000 ) 

COMMON/GR3/RESD( 1 ) 

LOGICAL  LG, DONE 
CHARACTER*4  CG,ADIR*1 , ANUX*1 
DATA  DONE  /.FALSE./ 

INTEGER  TEMP, CP, PH20,TFAR,RHOE, SPAR 

C  2  User  dimensions  own  arrays  here,  for  example: 

C  DIMENSION  UUH(10,10) ,UUC(10,10) ,UUX(10,10) ,UU2(10) 

PARAMETER  ( JNX-45 , JNY-40 , JNXY=JNX*JNY ) 

PARAMETER  (NDATA«15 ,NCURVES=5 ) 

DIMENSION  GAH(JNY,JNX) ,GP1 ( JNY , JNX) , GHl ( JNY , JNX ) , GCl ( JNY , JNX 1  , 

&  GC2(JNY,JNX) ,GC3 ( JNY, JNX) , GRH ( JNY , JNX ) , GTMP ( JNY , JNX  )  , 

E.  GVPR(  JNY,  JNX)  ,  GCP  ( JNY  ,  JNX )  ,  PHI  ( JNY  ,  JNX  )  ,A1(JNXY)  , 

5.  A2(JNXY)  ,A3(  JNXY)  ,A4(JNXY)  .A5(JNXY)  ,A6(  JNXY)  , 

6.  EFX(  JNXY)  ,EFY(  JNXY)  ,FMAG(  JNXY)  ,RP(JNXY'  , 

&  CTDATA ( NDATA , NCURVES ) 

DIMENSION  SC(4) 

:  3  User  places  his  data  statements  here,  for  example: 

C  DATA  NXDIM,NYDIM/10 , 10/ 

DATA  CTDATA  /O . 1 C , C . 1 5 , 0 . 2C  ,  C  .  2£  ,  0 . 30 , C . ?r , 0 . 4C , C . 45 , 3  . 5C  ,3. 55. 
&  0.60,0.65,0.70,0.76  ,0.0, 


non  o  o  o  n  nooo  nnnannnnn 


& 

E. 

& 

S> 

Se 

G. 

S> 


0.00,0.00,1.60,1.375,1.22,1.08,0.96,0.86,0.775,0.70 

5*0.00, 

0.00,1.68.1.42,1.22  ,1.08,0.95,0.86,0.775,0.71,0.64 
0.58,0.52,0.46,0.43  ,0.00, 

15*0.00, 

15*0.00/ 

EQUIVALENCE  ( TEMP ,  C4  )  ,  ( CP ,  C5  )  ,  (  P'H20  .  C8  )  ,  ( TEAR ,  C9  )  ,  ( RHOE ,  Cl  0  )  , 
(SPAR.Cll) 


4  Insert  own  coding  below  as  desired,  guided  by  GREX2  examples. 

Note  that  the  satellite-to-GREX2  special  data  in  the  labelled 
COMMONS  /RSG/,  /ISG/,  /LSG/  and  /CSG/  (which  are  now  automatically 
included  in  grdloc)  can  be  used  but  the  user  must  check  GREX2  for 
any  conflicting  uses.  The  same  comment  applies  to  the  EARTH-spare 

working  arrays  EASPl,  EASP2, - EASPIO.  If  the  call  to  GREX2  has 

been  deactivated  then  they  can  all  be  used  without  reservation. 


IXL=IABS(IXL) 

IF(IGR.EQ.13)  GO  TO  13 
IF(IGR.EQ.19 )  GO  TO  19 

GO  TO  (1,2,3,4,5,6,24,8,9,10,11,12,13,14,24,24,24,24,19,20,24, 
124,23,24) ,IGR 


—  GROUP  1 .  Run  title  and  other  preliminaries 

1  GO  TO  (1001,1002) ,ISC 
1001  CONTINUE 


NSC=4 

NFO«0 

TNY=1.E-15 

RGAS*RG(25) 

JSWPRN=TSTSWP 

PTRAP=RG(29) 


PI=3. 141592653 
RPM=RG(830) 

SHP=RG( 831 ) 

DIAFT=RG(52)/12. 

RHOAMB=RG(701) 

PCTK=RG(832) 

X0PROP=RG (43) *RG (31) 

Y0PROP*RG(44)*RG( 31 ) 

CALLWRIT2R('  XOPROP  ' ,X0PROP , ' , YOPROP  '.YOPROP) 

JCURVE*IG(875)  +  1 
NRAMP=MAX0(IG(876)  ,1) 


JNXNY=NX*NY 

JNXYZ=NX*NY*NZ 

RETURN 

1002  CONTINUE 

WRITE (6, 175)  JNXYZ 


.  . .  CONVERT  TO  MKS  UNITS  - 

CALL  WRITBL 

CALLWRIT4R('  RPM  ',RPM,',  SHP  ' , SHP , ' , Dia , Ft . ' , DIAFT , 
&  ' ,  %  Ke  '  , PCTK ) 


RPS=RPM/60. 

DIAM=DIAFT*. 3048 
POWER=SHP*745.7 

XCP=POWER/ (RHOAMB*RPS**3*DIAM**5) 

DBAR=0.75*DIAM 

CALLWRIT4R('  RPS  ',RPS,',  POWER  POWER, ' ,Dia,M. 

&  '  Cp  ' , XCP ) 

IF(XCP.LT.0.1  .OR.  XCP. GT. 0.8) 

5,  CALL  WRIT40('  ...  BIZARRE  Cp  VALUE _ 

< 

C  . . .  INTERPOLATE  TO  GET  Ct/Cp  Vs .  Cp  _ 

C 

XX=XCP 

DO  10020  II=2,NDATA 

10020  IF(XX.LT.CTDATA(II,1 ) )  GO  TO  10025 

CALL  WRIT40( 'ERROR  IN  INTERPOLATION  FOR  Ct/Cp  Vs.  Cp.') 
CALL  WAYOUT(l) 

10025  CONTINUE 
10=11-1 

X0=CTDATA(I0  ,1) 

XP=CTDATA(I0+1 , 1 ) 

IF( (XX-X0)/(XP-X0) .GT.0.5)  10=10+1 

X0=CTDATA(I0  ,1) 

XM=CTDATA(I0-1,1) 

XP=CTDATA( 10+1,1) 

Y0=CTDATA(I0  ,JCURVE) 

YM=CTDATA ( I 0- 1 , JCURVE ) 

YP=CTDATA ( lO+l , JCURV^ ) 

DX=(XP-XM)/2. 

YPO=(YP-YM)/(XP-XM) 

YPP0= ( YM-2 . *Y0+YP ) /DX**2 

DX=XX-X0 

TERM1=YP0*DX 

TERM2=0 . 5*YPP0*DX**2 

YX1=Y0  +  TERMl 

YX2=YX1  +  TERM2 

CTBCP=YX2 

CALL  WRITBL 

CALL  WRIT40('Y  =  Ct/Cp  IN  THE  FOLLOWING  ....  ') 

CALLWRIT3R('  Cp,-  ',XM,',  Cp,0  '  , XO ,  ' ,  Cp,+  ',XP) 
CALL  WRIT3R('  Ct/Cp YM ,' ,Ct/Cp, 0 YO Ct/Cp ,+', YP ) 
CALL  WRIT4R('  TERMl  ', TERMl,',  TERM2  ' , TERM2 , 

6.  '  Y",0  ',YP0,',  Y"".0  ',YPP0) 

CALLWRIT4R('  Cp  ' ,XX, ' , Y,0( 1 )  ' , YXl , ' , Y , 0 ( 2 )  ',YX2 

&  ', Ct/Cp  ',CTBCP) 

THRUST=CTBCP*POWER/ (RPS*DIAM ) 

APROP=PI*DIAM**2/4 . 

WPROP=SORT ( THRUST/ ( 2 . *RHOAMB*APROP ) ) 

UPROP=POWER/ {RHOAMB*APROP*WPROP*PI*RPS*DBAR ) 

POWERW= THRUST* WPROP 
POWERK  =  PCTK / 1 0  0 . *  POWER 
POWERU=POWER-POWERW-POWERK 

CALLWRIT4R('  THRUST  ', THRUST, ' ,  Area  ',A?ROP, 

&  ',W,prop  ', WPROP  ,',U,prop  ',U?ROP) 

CALLWRIT4R('  Power  '.POWER  Power',  w POWERW , 

£.  '  ,  Power,  u'  ,POWERU, ' ,  Power,  k'  ,  POWERK  ) 


DIAM, 

'  ) 


WPROP2=WPROP**2 

TBA=THRUST/APROP 


PUBA=POWERU/APROP 
PKB A = POWERK / APROP 
A2PI=2.*PI 
OMEGA=RPS*A2PI 
C 

IF ( JNY . GE . NY . AND . JNXY . GE . JNXNY )  RETURN 

CALL  WRIT3I ( '  NX  ' ,NX  , ' ,  NY  ' ,NY  , ' ,  NXNY  ' , JNXNY) 

CALLWRIT3I('  JNX  ' , JNX, ' ,  JNY  ' , JNY, ' ,  NXNYD  ' , JNXY  ) 

WRITE (6, 179) 

STOP 

175  FORMAT (/, IX, 'TOTAL  #  CELLS  :',I6) 

179  FORMAT ( IX , ' INCREASE  JNX  AND/OR  JNY  !!!!!',/, 

&  IX, 'THE  SHIT  WOULD  HAVE  HIT  THE  FAN . STOPPING.') 

0******.*********lk»************************************************ 

c 

C -  GROUP  2.  Transience;  time-step  specification 

C 

2  CONTINUE 
RETURN 

0***************************************************************** 

C 

C---  GROUP  3.  X-direction  grid  specification 
C 

3  CONTINUE 
RETURN 

0*  *****•**•*•*****•  It*  **********************************  It  *************  * 

C 

C -  GROUP  4.  Y-direction  grid  specification 

C 

4  CONTINUE 
RETURN 

0* **************************************************************** 
C 

C -  GROUP  5.  Z-direction  grid  specification 

n 

5  CONTINUE 
RETURN 

0***************************************************************** 

C 

0 -  GROUP  6.  Body-fitted  coordinates  or  grid  distortion 

C 

6  CONTINUE 
RETURN 

0************************************** *************************** 
C  *  Make  changes  for  this  group  only  in  group  19. 

0 -  GROUP  7.  Variables  stored,  solved  &  named 

0***************************************************************** 

C 

0 -  GROUP  8.  Terms  fin  differential  equations)  &  devices 

C 

e  GO  TO  (81,82,83,84,85,86,87,86,89,810,811,612,813,814,815) 

1 ,13C 

61  CONTINUE 

0  *  - SECTION  1 - 

C  For  UIAD.LE.GRND -  phase  1  additional  velocity  (VELAD) . 

RETURN 
82  CONTINUE 

0  *  - SECTION  2 - 

C  For  U2AD.LE.GRND -  phase  2  additional  velocity  (VELADi. 

RETURN 


i  u  u  'J  ' )  '  •  ■  •  '  •  r  c  o  u  c  DC 


83  CONTINUE 

*  - SECTION  3 - 

For  VIAD.LE.GRND -  phase  1  additional  velocity  (VELAD) . 

RETURN 

84  CONTINUE 

*  - SECTION  4 - 

For  V2AD.LE.GRND -  phase  2  additional  velocity  (VELAD). 

RETURN 

85  CONTINUE 


:  * - SECTION  5 - 

C  For  WIAD.LE.GRND -  phase  1  additional  velocity  (VELAD). 

RETURN 

86  CONTINUE 

*  - SECTION  6 - 

For  W2AD.LE.GRND -  phase  2  additional  velocity  (VELAD). 

RETURN 

87  CONTINUE 

*  - SECTION  7 - VOLUMETRIC  SOURCE  FOR  GALA 

RETURN 

88  CONTINUE 

*  SECTION  8 - CONVECTION  FLUXES 

RETURN 

89  CONTINUE 

*  -  SECTION  9  -  DIFFUSION  COEFFICIENTS 

RETURN 

810  CONTINUE 

*  -  SECTION  10  -  CONVECTION  NEIGHBOURS 

RETURN 

811  CONTINUE 

*  -  SECTION  11  -  DIFFUSION  NEIGHBOURS 

RETURN 

812  CONTINUE 

*  -  SECTION  12  -  LINEARISED  SOURCES 


RETURN 

813  CONTINUE 

*  - SECTION  13  -  CORRECTION  COEFFICIENTS 

RETURN 

814  CONTINUE 

*  -  SECTION  14  -  USER'S  SOLVER 

RETURN 

815  CONTINUE 

*  -  SECTION  15  -  CHANGE  SOLUTION 

RETURN 


*  Make  all  other  group-8  changes  in  group  19. 
*************************** ************************************** 


—  GROUP  9.  Properties  of  the  medium  (or  media) 


The  sections  in  this  group  are  arranged  sequentially  in  their 
order  of  calling  from  EARTH.  Thus,  as  can  be  seen  from  below, 
the  temperature  sections  (10  and  11)  precede  the  density 
C  sections  (1  and  3);  so,  density  formulae  can  refer  to 
temperature  stores  already  set, 

9  GO  TO  (91,92,93,94,95,96,97,98,99,900,901,902,903) , ISC 

0* **************************************************************** 


900  CONTINUE 

* - SECTION  10  - 

For  TMPl.LE.GRND - ohase-l  temperature  Index  AUXf TEMPI 

RETURN 

901  CONTINUE 


For  TMP2.LE.GRND- 
RETURN 
902  CONTINUE 


SECTION  11  - 

-  phase-2  temperature  Index  AUX(TEMP2) 


For  ELl.LE.GRND- 
RETURN 
903  CONTINUE 


SECTION  12  - 

-  phase-1  length  scale  Index  AUX(LENl) 


SECTION  13  - 

-  phase-2  length  scale  Index  AUX(LEN2 


For  EL2.LE.GRND - phase-2  length  scale  Index  AUX( 

RETURN 
91  CONTINUE 

* - SECTION  1 - 

For  RHOl.LE.GRND -  density  for  phase  1  Index  AUX(DENl). 


CALL  GETYX  ( PI ,GP1 , JNY , J^ 
CALL  GETYX  ( HI ,  GHl ,  JNY ,  Jt) 
CALL  GETYX  (Cl ,GC1 , JNY, JK 
CALL  GETYX  ( TEMP , GTMP , JNy 
CALL  GETYX  ( INAME ( ' VPOR ' ) 
DO  9101  IX=1,NX 
DO  9101  IY=1,NY 
IF  (GVPR(IY,IX) .LE.l.E-4) 
GC3(IY,IX)=0.0 
GTMP{IY,IX)=300. 

PHI (lY, IX) =0.0 

GRH(IY,IX)=1. 

GCP(IY,IX)=1000. 

GOTO  9101 
ENDIF 

-pd - Calculate  mass  fractions 

GC3 ( lY , IX ) =1 . 0-GCl ( lY , IX ) 


(P1,GP1,JNY,JNX) 

(H1,GH1,JNY,JNX) 

(C1,GC1,JNY,JNX) 

( TEMP , GTMP , JNY . JNX ) 

(INAME( 'VPOR' ) ,GVPR,JNY,JNX) 
1,NX  . 

1  ,NY 

,IX) .LE.l.E-4 )  THEN 


SC( 3)=(GC3(IY,IX)*RG(3)+GC1(IY,IX)*RG(7) )/RG(23) 
SC ( 4 ) = ( GC3 ( lY , IX ) *RG ( 4 ) +GC1 ( lY , IX ) *RG ( 8 ) ) /RG ( 24 ) 
SC(1)=AMAX1(1.E-10,SC(1) ) 

SC{2)=AMAX1(1.E-10,SC(2) ) 

SC(3)=AMAX1(1,E-10,SC{3) ) 

SC(4)=AMAX1(1.E-10,SC(4) ) 

TGUS=GTMP(iy,IX) 

HSTAT=GH1 ( lY , IX ) 

CALL  TEMPER  { HSTAT ,  TGUS  ,  TCELL ,  CPDR ,  RGAS ,  SC ,  NSC ,  NFO ) 

TCELL=AMAX1 ( VARMIN ( TEMP ) , TCELL ) 

TCELL=AMIN1 ( VARMAX ( TEMP ) , TCELL ) 

GP=PRESS0+GP1 ( lY , IX ) 

PHI ( lY , IX ) *1 . 0/ ( GP+TNY ) 

XMWA=1 .0/(SC(l )+SC(2)+SC( 3 )+SC(4) ) 

GRH ( lY , IX ) =GP*XMWA/ ( RGAS*TCELL+TNY ) 
GTMP(IY,IX)=TCELL 
GCP ( lY , IX ) =CPDR*RGAS 
.01  CONTINUE 

CALL  SETYX(A‘UX(DEN1  )  ,GRH, JNY, JNX) 

CALL  SETYX(C3 ,GC3 , JNY,JNX) 

CALL  SETYX( TEMP, GTMP, JNY, JNX) 

CALL  SETYX  (  CP  ,  GCP  ,  JNY  ,  J!,-/. , 


ijoo  oo»j  (juo  on  0(j  o«joo  »iO  no  Ou 


RETURN 

92  CONTINUE 

:  * - SECTION  2 - 

C  For  DRHIDP.LE.GRND -  D(LN(DEN) ) /DP  for  phase  1  (DIDP). 

CALL  SETYX (DIDP, PHI, JNY,JNX) 

RETURN 

93  CONTINUE 

C  * - SECTION  3 - 

For  RH02.LE.GRND - density  for  phase  2  Index  AUX(DEN2). 

RETURN 

94  CONTINUE 

c  * - SEcrrioN  4 - 

:  For  DRH2DP.LE.GRND -  D(LN(DEN) )/DP  for  phase  2  {D2DP). 

RETURN 

95  CONTINUE 

:  * - SECTION  5 - 

:  For  ENUT.LE.GRND -  reference  turbulent  kinematic  viscosity. 

RETURN 

96  CONTINUE 

;  * - SECTION  6 - 

C  For  ENUL.LE.GRND -  reference  laminar  kinematic  viscosity. 

RETURN 

97  CONTINUE 

*  - SECTION  7 - 

For  PRNDTL(  ).LE.GRND -  laminar  PRANDTL  nos.,  or  diffusivity. 

RETURN 

98  CONTINUE 

*  - SECTION  8 - 

For  PHINT(  ).LE.GRND -  interface  value  of  first  phase(FlIl). 

RETURN 

99  CONTINUE 

*  - SECTION  9 - 

For  PHINT(  ) .LE.GRND -  interface  value  of  second  phase(FII2) 

RETURN 

***************************************************************** 


-  GROUP  10.  Inter-phase-transfer  processes  and  properties 


10  GO  TO  (101,102,103,104) , ISC 

101  CONTINUE 

*  - SECTION  1 - 

For  CFIPS . LE . GRND -  inter-phase  friction  coeff.  AUX(INTFRC). 

RETURN 

102  CONTINUE 

*  - SECTION  2 - 

For  CMDOT . EQ . GRND-  inter-phase  mass  transfer  Index  AUX(INTMDT) 

RETURN 

103  CONTINUE 

*  - SECTION  3 - 

For  CINT(  ) .EQ.GRND -  phasel-to-interf ace  transfer 

coefficients  fCOIl) 


RETURN 
104  CONTINUE 

*  - SECTION  4  - 

For  CINT(  ) .EQ.GRND -  phase2-to-interface  transfer 

coefficients  (COI2) 


RETURN 


-  GROUP  11.  Initialization  of  variable  or  porosity  fields 


o  o  n  o  o  n  n 


c 

11  CONTINUE 
RETURN 

C*******  ***************************  **1c-k***ic***1c**c  ***************  it* 

—  GROUP  12.  Convection  and  diffusion  adjustments 

12  CONTINUE 
RETURN 

***********************************************************'^**'^i[ 

—  GROUP  13.  Boundary  conditions  and  special  sources 

13  CONTINUE 

GO  TO  (130,131,132,133,134,135,136,137,138,139,1310, 
11311,1312,1313,1314,1315,1316,1317,1318,1319,1320,1321 ) ,ISC 

130  CONTINUE 

C - SECTION  1 - coefficient  =  GRND 

RETURN 

131  CONTINUE 

C - SECTION  2 - coefficient  =  GRNDl  . 

RETURN 

132  CONTINUE 

C - SECTION  3 - coefficient  =  GRND2 

RETURN 

133  CONTINUE 

C - SECTION  4 - coefficient  =  GRND3 

RETURN 

134  CONTINUE 

c - SECTION  5 - coefficient  =  GRND4 

RETURN 

135  CONTINUE 

C - SECTION  6 - coefficient  =  GRND5 

RETURN 

136  CONTINUE 

C - SECTION  7  coefficient  =  GRND6 

RETURN 

137  CONTINUE 

C - SECTION  8  coefficient  =  GRND7 

IF( INDVAR.GT.Pl )  GO  TO  13799 
CALL  GETYX ( AUX ( DENI ) , A1 , NY , NX ) 

CALL  GETYX (PI  ,A2,NY,NX) 

CALL  GETCOV  ( NPATCH ,  INAME  (  '  UCRT '  )  ,  COEFF ,  GKLOSS  ) 

CALL  GETCOV ( NPATCH ,  PI  , COEFF, GPBV  ) 

1= (IXF-2 )*NY 
DO  13701  II=IXP,IXL 
I=I  +  NY 

DO  13702  J=IYF,IYL 
IJ=I  +  J 

DELTAP=AMAX1 ( ABS { A2 ( IJ ) -GPBV ) . PTRAP ) 

RHO  =A1 ( IJ ) 

COEFF  =SQRT ( 2 . *RHO/ { GKLOSS*DELTAP ) ) 

A1 ( IJ ) =COEFF 

137C2  CONTINUE 

13701  CONTINUE 

CALL  SETYX(CO,Al,NY,NX) 

RETURN 

13799  CALL  WRIT40( 'CO  =  GRND7  FOR  VARIABLE  BESIDES  PI  ! ! ! !  ' \ 

CALL  WAYOUT ( 1 ) 

RETURN 


138  CONTINUE 

n - SECTION  9 - coefficient  =  GRND8 

C  . . .  GENERATE  WALL  SHEAR  COEFFICIENTS  - 

C 

CALL  FNLGLW(CO,CO.AK,1.0001,EWAL,4) 

C  . . .  NOW  CONVERT  TO  Stanton  # ' s  - 

CALL  GETYX(CO,Al,NY,NX) 

RPRL=1 . /PRNDTL(H1 ) 

RPRT*1./PRT(H1 ) 

P  =9.*(RPRT/RPRL  -  1 . ) * (RPRL/RPRT ) **0 . 25 
I=(IXF-2)*NY 
DO  13801  II=IXF,IXL 
I=I  +  NY 

DO  13802  J=IYF,IYL 
IJ=I  +  J 
S=A1(IJ) 

STL=S*RPRL 

STT=S*RPRT/ ( 1 .  +  P*S0RT(S)) 

A1 ( IJ ) =AMAX1 ( STL , STT ) 

.3802  CONTINUE 
3801  CONTINUE 
C 

C  . . .  NOW  ASSEMBLE  COMPOSITE  HEAT  TRANSFER  COEFFICIENTS  - 

CALL  GETYX(AUX(DEN1 ) ,A2,NY,NX) 

CALL  GETYX(LD7  , A3, NY, NX) 

CALL  GETYX(CP  ,A4,NY,NX) 

CALL  GETCOV ( NPATCH , INAME ( ' UCRT ' ) , COND , THICK ) 

CWALL*COND/ ( THICK+TINY ) 

CALL  SUB4(I1,IXF,I2,IXL,J1,IYF,J2,IYL) 

READ ( NPATCH ( 8 : 8 ) , ' ( A1 ) ' )  ADIR 
NDIREC=0 

IF(ADIR.EQ. 'E'  .OR.  ADIR.EQ.'e')  NDIREC=  1 
IF(ADIR.EQ. 'W'  .OR.  ADIR.EQ.'w')  NDIREC=-1 
IF(ADIR.EQ. 'N'  .OR.  ADIR.EQ.'n')  NDIREC=  2 
IF(ADIR.EQ. 'S'  .OR.  ADIR. EQ. 'S')  NDIREC=-2 
IDIR=IABS ( NDIREC ) 

IF(IDIR.EQ.l)  THEN 
KAREA=5 
KADD=NY 
12=11 

ELSEIF(IDIR.EQ.2)  THEN 
KAREA=7 
KADD=1 
J2=J1 
ELSE 

CALL  WRIT40( 'PATCH  NAME  PROTOCOL  VIOLATED  FOR  GRND8  ') 
CALL  WRIT40( 'COEFFICIENT  OF  CONJUGATE  HEAT  TRANSFER  ') 
CALL  WRIT40( 'MODEL.  TSK  TSK  TSK  ') 

CALL  WAYOUT ( 1 ; 

END  IF 
r 

I=(I1-2)*NY 
DO  13811  II=I1 . 12 
I=I  *  NY 

DO  13812  J=J1,J2 


n  n  n  n  n  n  cy  n  h-  o  »-  »-  o  o  o  n  y-- 


IJ1=I  +  J 
IJ2-IJ1  +  KADD 
ST1=A1(IJ1) 

ST2=A1(IJ2) 

R01=A2(IJ1) 

R02*A2(IJ2) 

VW1=A3(IJ1 ) 

VW2=A3(IJ2) 

CP1=A4(IJ1) 

CP2=A4(IJ2) 

COl =R01 * VWl *CP1 *ST1 
C02=R02*VW2*CP2*ST2 

C0EFF=C01*CWALL*C02/(C01*CWALL  +  C01*C02  +  CWALL*C02  +  TINY) 
A5  ( IJl ) =C0EFF/CP1 
A5  ( IJ2 ) =C0EFF/CP2 
A6  ( IJl ) =COEFF 
A6 ( IJ2 ) =COEFF 
3812  CONTINUE 
3811  CONTINUE 

CALL  SETYX{C6,A5,Ny,NX) 

CALL  SETYX ( C7 , A6 , NY , NX ) 

...  NOW  MULTIPLY  BY  CORRECT  AREA'S  &  DIVIDE  BY  PATGEO,RHO  G>  Vwall  ... 

CALL  GTIZYX(KAREA,.IZ,A1  ,NY,NX) 

I=(I1-2)*NY 
DO  13821  11=11,12 
I=I  +  NY 

DO  13822  J=J1,J2 
IJ1*I  +  J 
IJ2=IJ1  +  KADD 
AREA=A1 ( IJl ) 

AS ( IJl ) =A5 ( IJl ) *AREA 
AS ( I J2 ) =A5 ( I J2 ) *AREA 
3822  CONTINUE 
3821  CONTINUE 

CALL  GETYX(PATGEO,Al,Ny,NX) 

I=(IXF-2)*NY 
DO  13831  II=IXF,IXL 
I=I  +  NY 

DO  13832  J=IYF,IYL 
IJ=I  +  J 

A5(IJ)=A5(IJ)/(A1(IJ)*A2(IJ)*A3(IJ)  +  TINY) 

3832  CONTINUE 
3831  CONTINUE 

CALL  SETYX (CO, AS, NY, NX) 

CALL  FNl ( LGENl ,0.0) 

. . .  ADD  UP  TOTAL  HEAT  TRANSFERRED  _ 

IF(ISWEE?.LT.LSWEEP-1.AND.MOD(ISWEEP,IG(9011  ) -NE.O)  RETURN  ' 

CALL  WRITBL 

CALL  WRIT40( 'ADDING  UP  TOTAL  Qdot  FROM  DUCT  TO  AIR.  ') 

CALL  WRIT2I ( 'SWEEP  #  ' , ISWEEP , ' , SLAB  *  '.IZSTEP) 

CALL  GETYX(H1 ,A4 ,NY,NX) 

CALL  GETYX{CP,A2,NY,NX) 


CALL  SUB4 ( II , IXP ,12, IXL , J1 , lYF , J2 , lYL ) 

IF  (NDIREC.EQ.  1)  THEN 
11  =  12 
KADD=-NY 

ELSEIF(NDIREC.E0.-1 )  THEN 
12  =  11 
KADD=  NY 

ELSEIF (NDIREC.EQ.  2)  THEN 
J1=J2 
KADD=-1 

ELSEIF ( NDIREC . EQ . - 2 )  THEN 
J2=J1 
KADD=  1 
ENDIF 
C 

READ(NPATCH(7:7) , ' (Al) ' )  ANUX 
I=(I1-2)*NY 
DO  13841  11=11,12 
I=I  +  NY 

DO  13842  J=J1,J2 
IJ1=I  +  J 
IJ2=IJ1  +  KADD 
H11=A4(IJ1 ) 

H12=A4(IJ2) 

CP1=A2(IJ1 ) 

CP2=A2(IJ2) 

C01=A5 ( IJl ) *A1 ( IJl ) *A3 ( IJl ) 

VA1=H12*CP1/CP2 
QDTTOT=QDTTOT  +  COl* ( VAl-Hll ) 

IF(ANUX.EQ. '1' )  QDOT01=QDOT01  +  COl* ( VAl-Hll ) 
IF(ANUX.EQ. '2' )  QDOT02=QDOT02  +  COl* (VAl-Hll ) 
IF(ANUX.EQ. ' 3' )  QDOT03=QDOT03  +  COl* (VAl-Hll ) 
IF(ANUX.EQ. '4' )  QDOT04=QDOT04  +  COl* (VAl-Hll ) 


.3842 

CONTINUE 

13841 

CONTINUE 

RETURN 

139 

CONTINUE 

c - 

RETURN 

--  SECTION  10  - 

-  coefficient  = 

GRND9 

1310 

CONTINUE 

c - 

RETURN 

—  SECTION  11  - 

-  coefficient  = 

GRNDIO 

1311 

CONTINUE 

c - 

RETURN 

—  SECTION  12  - 

-  value 

=  GRND 

1312 

CONTINUE 

RETURN 

—  SECTION  13  - 

-  value 

=  GRNDl 

1313 

CONTINUE 

RETURN 

—  SECTION  14  - 

-  value 

=  GRND 2 

1314 

CONTINUE 

RETURN 

1315 

CONTINUE 

— 

—  SECTION  16  - 

-  value 

=  GRND4 

RETURN 

1316  CONTINUE 


SECTION  17 


value  =  GRn: 


RETURN 

1317  CONTINUE 

C - SECTION  18 - value  =  GRND6 

RETURN 

1318  CONTINUE 

C - SECTION  19 - value  =  GRND7 

IF ( INDVAR.lt. U1  .OR.  INDVAR . GT . W2 )  GC  TO  13189  ' 

CALL  GETYX(AUX(DEN1) ,A1,NY,NX) 

CALL  GETYX(P1  ,A2,NY,NX) 

CALL  GETCOV ( NPATCH , INAME ( ' UCRT ' ) , COEFF , GKLOSS ) 

CALL  GETCOV (NPATCH,  PI  , COEFF, GPBV  ) 

I=(IXF-2)*NY 
DO  13181  II=IXF,IXL 
I=I  +  NY 

DO  13182  J=IYF,IYL 
IJ=I  +  J 

DELTAP=  A2(IJ)-GPBV 
ABSDP  =  ABS(DELTAP) 

RHO  =  A1  ( IJ  ) 

VMAG  =  SQRT ( 2 . *ABSDP/ ( GKLOSS*RHO ) ) 

A1 ( IJ ) = -SIGN ( VMAG , DELTAP ) 

13182  CONTINUE 
13181  CONTINUE 

CALL  SETYX ( VAL , A1 , NY , NX ) 

RETURN 

13189  CALL  WRIT40('VAL  =  GRND7  FOR  VARBLE  BESIDES  AU,V,wA1.') 

CALL  WAYOUT(l) 

RETURN 

1319  CONTINUE 

C - SECTION  20 - value  =  GRND8 

CALL  GETYX(H1,A1,NY,NX) 

CALL  GETYX(CP,A2,NY,NX) 

C 

I=(I1-2)*NY 
DO  13191  11*11,12 
I=I  +  NY 

DO  13192  J=J1,J2 
IJ1=I  +  J 
IJ2=IJ1  +  KADD 
H11=A1(IJ1) 

H12=A1 (IJ2) 

CP1=A2(IJ1 ) 

CP2=A2(IJ2) 

VA1=H12*CP1/CP2 
VA2*H11*CP2/CP1 
A3(1J1 )=VA1 
A3 (IJ2)=VA2 
13192  CONTINUE 
13191  CONTINUE 
C 

CALL  SETYX (VAL, A3, NY, NX) 

RETURN 

1320  CONTINUE 

C - SECTION  21  -  value  =  GRND9 

IF ( INDVAR . LT . W1 )  THEN 
IF( INDVAR. EQ. VI )  THEN 

CALL  GTIZYX(83,IZ,A1,NY,NX) 

CALL  GTIZYX(84,IZ,A2,NY,NX) 

IF(LG( 20 ) ) 

&  CALL  WRIT40('IN  GROUP  13, VI  SECTION  .... 


Et 

& 

13111 

St 

St 

St 

13112 

St 

s. 


E. 

L3113 

St 


St 

.5114 

St 

c 


I1=(IXF-2)*NY 
IJ1*I1+IYF+1 
IJ2=I1+IYL 
IF(LG(20) ) 

CALL  WRIT40( 'BEGIN  1ST  SOURCE  LOOP  _  ') 

DO  13111  I=IXF,1XL 

IJ1=IJ1+NY 

IJ2=IJ2+NY 

IF(LG(20))  CALLWRIT3I('  IX  I  IJl  ',IJ1, 

IJ2  ',IJ2) 

DO  13111  IJ=IJ1,IJ2 

A3(IJ)=0.5*FMAG(IJ)*(EFX(IJ)*A1(IJ)  + 

EFY ( IJ ) *A2 ( IJ ) ) 

I1=(IXF-2)*NY 
IJ1=I1+IYF 
IJ2=I1+IYL-1 
IF(LG(20) ) 

CALL  WRIT40( 'BEGIN  2ND  SOURCE  LOOP  _  ') 

DO  13112  I=IXF,IXL 

IJ1=IJ1+NY 

IJ2=IJ2+NY 

IF(LG(20))  CALL  WRIT3I('  IX  IJl  ',IJ1, 

IJ2  ',IJ2) 

DO  13112  IJ=IJ1,IJ2 

A3(IJ)=A3(IJ)  +  0.5*FMAG(IJ+1)'*(EPX(IJ+1)*A1(IJ)  + 

EFY(IJ+1)*A2(IJ) ) 

CALL  SETYX(VAL,A3,NY,NX) 

RETURN 
ENDIF 
IP(LG(20) ) 

CALL  WRIT40('IN  GROUP  13, U1  SECTION  _  ') 

CALL  GTI2YX(80,IZ,A1,NY,NX) 

CALL  GTI2YX(81,IZ,A2,NY,NX) 

11= (IXF-1 )*NY 

IJ1=I1+IYF 

IJ2=I1+IYL 

DO  13113  I=IXF,IXL 

IJ1=IJ1+NY 

IJ2=IJ2+NY 

IF(LG(20))  CALLWRIT3I('  IX  I  IJl  ',IJ1, 

IJ2  ',IJ2) 

DO  13113  IJ=IJ1,IJ2 

A3 ( I J ) =0 . 5*FMAG ( I J ) * ( EFX ( I J ) *A1 ( IJ )  + 

EFY ( I J ) *A2 ( I J ) ) 

I1={IXF-2)*NY 

IJ1=I1+IYF 

IJ2=I1+IYL 

DO  13114  I=IXF,IXL-1 

IJ1=IJ1+NY 

:J2=IJ2+NY 

IF(LG(20))  CALL  WRIT3I('  IX  ' ,  I  , ' ,  IJl  ' , I J1 , 

IJ2  ',IJ2) 

DO  13114  IJ=IJ1,IJ2 

A3  (  I J  )  =A3  ( IJ  )  +  0 . 5*FMAGi  IJ+Ni  )  *  ( EFX  ( IJ  +  NY  )  *A1  ^  I J  J  -‘- 

EFy{IJ+NY)*A2(IJ) ) 


CALL  SETYX(VAL,A3 ,Ny ,NX) 
RETURN 


o  o  o  n  o  o 


ELSEIP(INDVAR.EQ.Wl)  THEN 
IF(LG(20) ) 

&  CALL  WRIT40('IN  GROUP  13,W1  SECTION  _  ') 

CALL  GTIZYX(28,IZ,A1,NY,NX) 

CONST=2.*WPROP2 
DO  13115  IJ=1,JNXNY 
13115  Al(IJ)=CONST/(Al(IJ)  +  TINY) 

CALL  SETYX(VAL,A1,NY,NX) 

RETURN 

.  .  .  KE-EP  SECTION  .... 

...  Pk(r)=Ck  *  Uprop(r)**2  W/Ck=64*POWERK/ ( 2*Pi  *  OMEGA**2  *  DIAM**4) 
Pk(r)=CK  *  (OMEGA*r)**2 

ELSE 

FRAC=  ( FLOAT  ( ISWEEP-FSWEEP+1 )  /FLOAT ( NRAMP )  )  **2 
FRAC=AMIN1 ( AMAXl ( 0 . , FRAC ) , 1 . ) 

CK  =  FRAC  *  64.*POWERK/{A2PI  *  OMEGA**2  *  DIAM**4 ) 

I1=(IXF-2)*NY 
IJ1=I1+IYF 
IJ2=I1+IYL 
IF(LG(20) ) 

S.  CALL  WRIT40  ( 'BEGIN  Pk  ( r )  LOOP  ....  ') 

DO  13118  I=IXF,IXL 
IJ1=IJ1+NY 
IJ2=IJ2+NY 

IF(LG(20))  CALLWRIT3I{'  IX  ',.1  IJl  ' , IJl , 

S.  IJ2  ',:J2) 

DO  13118  IJ*IJ1,IJ2 
RR=RP(IJ) 

RW=RR*OMEGA 

13118  A1 (IJ)*CK*RW**2 
IF(INDVAR.GT.KE)  THEN 

CALL  GETYX(AUX(VIST) ,A2,NY,NX) 

CALL  GETYX(AUX(LEN1) ,A3,NY,NX) 

C0NST=C1E*CD**2/CMUCD 
11= ( IXF-2 ) *NY 
IJ1=I1+IYF 
IJ2=I1+IYL 
IF(LG{ 20) ) 

&  CALL  WRIT40( 'BEGIN  Cl*Pk ( r ) *EP/KE  LOOP  ....  ') 

DO  13119  I=IXF,IXL 

IJ1=IJ1+NY 

IJ2=IJ2+NY 

IF(LG(20))  CALLWRIT3I('  IX  I  IJl  '  , IJl . 

£<  ',  IJ2  ',IJ2) 

DO  13119  IJ=IJ1,IJ2 

13119  A1 ( IJ ) =CONST*Al ( IJ ) *A2 { IJ ) /A3 ( IJ ' **2 
END  IF 

CALL  3ETYX(VAL,Al,Ny,NX) 

ENDIF 

RETURN 

:3"1  CO.NTINCE 

C - SECTION  22  - value  =  GRNLIO 

DO  13211  IX=1,NX 

DO  13211  IY=1,NY 

PHI / lY , IX ) =RGf  804 ) *XFCTE 

I  .  'XEiiGIi^'  '  ,  'V 

Iri  NFATCH.EQ.  '  XENGOUT  '  )  ?HI  (  lY  ,  IX  =?.:  805  .  *XFCT£ 


13211  CONTINUE 

CALL  SETYX ( VAL , PHI , JNY , JNX ) 

RETURN 

Q*********************************************** **************** 

c 

C -  GROUP  14.  Downstream  pressure  for  PARAB=.TRUE. 

w 

14  CONTINUE 
RETURN 

P*********************************************** **************** 

C  *  Make  changes  for  this  group  only  in  group  19. 

C GROUP  15.  Termination  of  sweeps 

C GROUP  16.  Termination  of  iterations 

C —  GROUP  17.  Under-relaxation  devices 

C -  GROUP  18.  Limits  on  variables  or  increments  to  them 

0************************************************  *************** 
C 

C -  GROUP  19.  Special  calls  to  GROUND  from  EARTH 

C 

19  GO  TO  (191,192,193,194,195,196,197,198) , ISC 
191  CONTINUE 

C  * - SECTION  1 - START  OF  TIME  STEP. 

C 

C-pd - Misc - 

r* 

IF{IG(999) .EQ.l)  STOP 
ODTTOT=0.0 
ODOTT1=0.0 
QDOTT2=0.0 
0DOTT3=0.0 
QDOTT4=0.0 
IPASS*0 
IRAXV=0 
IRAXT=0 
IRAXS=0 
XFCTE=1.0 
ITST=TSTSWP 
INPR=NPRMON 
NPRM0N=1 
C 

C-pd - Assign  monitoring  locations - 

C 

IXMONl  =IXMON 
lYMONl  =IYMON 
IZMONl  =IZMON 
C 

IXMON2  =IG(11) 

IYM0N2  =IG(12) 

IZMON2  =IG(13) 

IXM0N3  =IG(14) 

IYMON3  =IG(15) 

IZMON3  =IG(16) 

W 

IXMON4  =IG(17) 

IYM0N4  =IG(18)  * 

IZM0N4  *IG(19) 

C 

IXMC!J5  =IG(2C} 

IYMON5  =IG(21) 


onnnnnno 


IZM0N5  *IG(22) 
C 

IXM0N6  =IG(23) 
IYM0N6.  =IG(24) 
IZM0N6  =IG(25) 
C 

IXM0N7  =IG(26) 
IYM0N7  =IG(27) 
IZM0N7  =IG(28) 
C 

IXM0N8  =IG(29) 
IYM0N8  *IG(30) 
IZM0N8  =IG(31) 
C 

IXM0N9  =IG(32) 
IYM0N9  =IG(33) 
IZM0N9  =IG(34) 
C 

IXMON10=IG( 35) 
IYMON10=IG(36) 
IZMON10=IG( 37 ) 


RETURN 
192  CONTINUE 
* _ 


SECTION  2  -  START  OF  SWEEP. 


-pd - WARNING:  machine  dependent - 

call  flush{6) 

. . .  COMPUTE  rP , Fmag , ePx , eFy  _ 

I F ( I SWEEP . EQ . FSWEEP )  THEN 

CALL  GETPTC ( ' YPROP  ' ,TyPE , IXF, IXL , lYF, lYL , IZF, IZL , ITF , ITL ) 

CALL  GTIZyX( 68,IZF,A1,NY,NX) 

CALL  GTIZYX(69,IZF,A2,NY,NX) 

EWZ=SIGN(1. ,RPS) 

I1=(IXF-2)*NY 
IJ1=I1+IYF+1 
IJ2=I1+IYL 
IF(LG(20) ) 

&  CALL  WRIT40( 'BEGIN  Fmag  LOOP  _  ') 

DO  19201  I=IXF,IXL 
IJl=IJl+Ny 
IJ2=IJ2+NY 

IF(LG(20))  CALLWRIT3I('  IX  I  IJl  ',IJ1, 

S.  IJ2  '.IJ2) 

DO  19201  IJ=IJ1,IJ2 
RX=A1 (IJ)-XOPROP 
RY=A2(IJ)-YOPROP 
RR=S0RT{RX*RX  +  RY*RY )  +  TINY 
RP(IJ)=RR 
RW=:RR*OMEGA 
ERX=RX/RR 
ERY=RY/RR 
EFX(IJ)*-EWZ*ERY 
EFY(IJ)=  EWZ*ERX 
19201  PMAG(IJ)=PUBA/RW 

IF  ,'  (  LSWEEP-F3WEE?  )  .  LT  .  1 1  ;  THEN 

CALL  SUB4 ( IXF , 1 , IXL , NX , I YF , 1 , 1 Y1 . NY ; 


CALL  WRIT2R('  XO , prop ' ,XOPROP YO , prop ' ,YOPROP ) 
CALL  PRNYX('  rP  ' ,RP  ,NY,NX) 

CALL  PRNYX('  eFx',EFX  ,NY,NX) 

CALL  PRNYXC  eFy',EFY  ,NY,NX) 

CALL  PRNYX('  6F6' ,FMAG,NY,NX) 

ENDIF 

ENDIF 

C 

C-pd - Check  to  reset  tstswp - 

IOPEN=0 

IF(ITST.NE. TSTSWP)  IPASS=IPASS+1 
IF(IPASS.GT.IO)  THEN 
IPASS=0 
TSTSWP=ITST 
ENDIF 

C-pd - Init  stuff  for  printout  of  max  and  min - 

XP1MIN=  1000000.0 
XP1MAX=-1000000.0 
XU1MIN=  1000000.0 
XU1MAX=-1000000.0 
XV1MIN=  1000000.0 
XV1MAX=-1000000.0 
XW1MIN=  1000000.0 
XW1MAX=-1000000.0 
XKEMIN=  1000000.0 
XKEMAX=-1000000.0 
XEPMIN*  1000000.0 
XEPMAX=-1000000.0 
‘XHIMIN*  1000000.0 
XH1MAX=-1000000.0 
XT1MIN=  1000000.0 
XT1MAX=-1000000.0 
XETMIN=  1000000.0 
XETMAX=-1000000.0 
IXPMAX=0 
IYPMAX=0 
IZPMAX=0 
IXPMIN=0 
IYPMIN=0 
IZPMIN»0 
IXUMAX»0 
IYUMAX=0 
IZUMAX=0 
IXUMIN=0 
IYUMIN=0 
IZUMIN=0 
IXVMAX=0 
IYVMAX=0 
IZVMAX=0 
IXVMIN=0 
IYVMIN-0 
IZVMIN=0 
TXWMAX=0 
IYWMAX=0 
IZWMAX=0 
IXWMIN=0 
IYWMIN»0 


o  t)  o  o  tJ  u  u  o  o  o  u  o  ij  c)  n  c)  ci  u  u  c )  o 


IZVIMIN=0 

IXKMAX=0 

iyKMAX=0 

IZKMAX=0 

IXKMIN=0 

iyKMIN=0 

IZKMIN=0 

IXEMAX=0 

IYEMAX=0 

IZEMAX=0 

IXEMIN=0 

iyEMIN=0 

I ZEMIN* 0 

IXHMAX=0 

IYHMAX=0 

IZHMAX=0 

IXHMIN=0 

IYHMIN=0 

IZHMIN=0 

IXTMAX=0 

IYTMAX=0 

IZTMAX=0 

IXTMIN=0 

IYTMIN=0 

IZTMIN=0 

IXXMAX=0 

IYXMAX=0 

IZXMAX=0 

IXXMIN=0 

IYXMIN*0 

IZXMIN*0 


r» 

w 


RETURN 
193  CONTINUE 


*  - SECTION  3 - START  OF  IZ  SLAB. 

RETURN 

194  CONTINUE 

*  -  SECTION  4  -  START  OF  ITERATION. 

IF{IRAXV.EQ.l )  THEN 

CALL  XSETCV ( '  RAXl '  ,  U1 , XCOF , XVEL , RAXFTV ,1.0) 

CALL  XSETCV ( 'RAXl' ,  VI , XCOF, XVEL, RAXFTV, 1 . 0 ) 

CALL  XSETCV ( 'RAXl' ,  W1 , XCOF, XVEL, RAXFTV, 1 . 0 ) 

WRITE (6,*)'  CO  FROM  SETCV  VEL  ->  ',XC0F 
IRAXV=0 


ENDIF 

IF(IRAXT.EQ.l)  THEN 
CALL  XSETCV ( 'RAXl ' , 
CALL  XSETCV ( ' KAXl ' , 
WRITE ( 6 , * ) '  CO  PROM 
IRAXT=0 

ENDIF 

IFdRAXS.EQ.  1 )  THEN 
CALL  XSETCV ( 'RAXl ' , 
CALL  XSETCV ( ' RAXl ' , 
CALL  XSETCV ( 'RAXl ' , 
WRITE ( 6 , * ) '  CO  PROM 
IRAXS*0 
ENDIF 


KE , XCOF , XVEL , RAXFTT ,1.0) 
EP , XCOF , XVEL , RAXFTT ,1.0) 
SETCV  TUR  ->  ',XC0F 


HI , XCOF , XVEL , RAXFTS ,1.0) 
Cl , XCOF , XVEL , RAXFTS ,1.0) 
C2 , XCOF , XVEL , RAXFTS ,1.0) 
SETCV  SCA  ->  '.XCOF 


pd - Modify  inlet  areas 


c 

IF(IZ.EQ.IG(711) )  THEN 

CALL  GTIZYX(9,IZ,GAH,JNY,JNX) 

SU^iBsO.O 

DO  19302  IX=IG(712) ,IG(713) 

DO  19302  IY=IG(714) ,IG(715) 

SUMB=SUMB+GAH ( lY , IX ) 

19302  CONTINUE 
ENDIP 

IF(I2.EQ.NZ)  THEN 
XFCTE=RG( 802 ) /SUMB 

:  CALL  XSETCV( 'XENGOUT' ,P1,XCOF,XVEL,1.0,XFCTE) 

:  CALL  XSETCV( 'XENGIN' ,  PI ,XCOF,XVEL, 1 . 0 ,XFCTE ) 

ENDIP 


RETURN 

195  CONTINUE 

r,  * - SECTION  5 - FINISH  OF  ITERATION. 

RETURN 

196  CONTINUE 

C  * - SECTION  6 - FINISH  OF  IZ  SLAB. 


CALL  GETCAR 

IF  (MOD(ISWEEP,IG(902) ) .NE.O.AND.ISWEEP.NE.LSWEEP-1 )  GOTO  1961 
IF(I2.EQ.l)  WRITE (6,*)'  ==>  CALCULATING  ENGLISH  UNITS  ' 

0-pd - Dispensed  by  DBS  for  unknown  reasons??????????????????????????? 

:  CALL  BCARTC{1,1) 

CALL  GET YX (PI, PHI , JNY , JNX ) 

DO  19611  IX=1,NX 
DO  19611  IY=1,NY 

19611  PHI(IY,IX)*PHI(IY,IX)*RG( 36 ) 

CALL  SETYX(PH20,PHI,J1«, JNX) 

CALL  GETYX ( INAME ( ' UCRT ' ) , PHI , JNY , JNX ) 

DO  19612  IX=1,NX 
DO  19612  iy=l,NY 

X 9612  PHI (lY , IX ) =PHI ( lY , IX ) *RG ( 37 ) 

CALL  SETYX ( U 2 , PHI , JNY , JNX ) 

CALL  GETYX ( INAME ( ' VCRT ' ) , PHI , JNY , JNX ) 

DO  19613  IX=1,NX 
DO  19613  IY=1,NY 

9613  PHI ( lY , IX ) =PHI ( lY , IX ) *RG ( 37 ) 

CALL  SETYX (V2, PHI, JNY, JNX) 

r. 

CALL  GETYX ( INAME ( 'WCRT ' ) , PHI , JNY , JNX ) 

DO  19614  IX=1,NX 
DO  19614  IY=1,NY 

9614  PHI(IY,IX)=PHI(IY,IX)*RG(37) 

CALL  SETYX {W2, PHI, JNY, JNX) 

CALL  GETYX (TEMP, PHI , JNY, JNX) 

DO  19615  IX=1,NX 
DO  19615  IY=1,NY 

19615  PHI ( lY , IX ) =PHI ( lY , IX ) /RG( 3 3 ) -RG( 32 ) 

CALL  SETYX (TPAR, PHI , JNY, JNX) 

CALL  GETYX ( AUX ( DENI ) , PHI , JNY , JNX ) 

DO  19616  IX=1,NX 


nan 


DO  19616  iy=i,Ny 

19616  PHI(iy,IX)=PHI(iy,IX)*RG(38) 

CALL  SETyX(RHOE,PHI,JNy,JNX) 

• 

-pd - Find  max  and  min - 

1961  IF(MOD(ISWEEP,NPRMON) .EQ.O)  THEN 
CALL  GETyX(Pl,PHI,JNY,JNX) 

CALL  GETyX  ( INAME ( ' VPOR ' ) , GVPR , JNy , JNX ) 
DO  19617  IX=1,NX 
DO  19617  iy*i,Ny 

IF  (GVPR(iy,IX) .LE.l.E-4)  GOTO  19617 
IP(PHI(iy,IX) .GT.XPIMAX)  THEN 
XPlMAX=PHI(iy ,IX) 

IXPMAX=IX 

iypMAx=iy 

IZPMAX=IZ 

ENDIF 

IF(PHI(iy,IX) .LT.XPIMIN)  THEN 
XPlMIN=PHI(iy,IX) 

IXPMIN=IX 

IYPMIN=iy 

IZPMIN=IZ 

ENDIF 

19617  CONTINUE 

C 

CALL  GETYX (Ul, PHI, JNY, JNX) 

CALL  GETYX  ( INAME ( ' VPOR ' ) , GVPR , JNY , JNX ) 
DO  19618  IX=1,NX 
DO  19618  IY=1,NY 

IF  (GVPR(IY, IX) .LE.l.E-4)  GOTO  19618 
IF(PHI(iy,IX) .GT.XUIMAX)  THEN 
XU1MAX=PH1(IY,IX) 

IXUMAX=IX 

iyUMAX=IY 

IZUMAX=IZ 

ENDIF 

IF(PHI(IY,IX) .LT.XUIMIN)  THEN 
XUlMIN=PHI(iy,IX) 

IXUMIN=IX 

IYUMIN=IY 

IZUMIN=IZ 

ENDIF 

19618  CONTINUE 

C 

CALL  GETYX (VI, PHI, JNY, JNX) 

CALL  GETYX  ( INAME ( ' VPOR ' ) , GVPR , JNY , JNX ) 
DO  19619  IX*1,NX 
DO  19619  IY=1,NY 

IF  fGVPRdY, IX)  .LE.l.E-4)  GOTO  19619 
IFfPHI {IY,IX) .GT.XVIMAX)  THEN 
XV1MAX=PHI (IY,IX) 

IXVMAX=IX 

IYVMAX=IY 

IZVMAX=IZ 

ENDIF 

IF(PHI(IY,IX) .LT.XVIMIN)  THEN 
XVlMIN=PHl(iy,IX) 

IXVMIN=IX 

IYVMIN=IY 


I2VMIN=IZ 

ENDIF 

.9619  CONTINUE 
C 

CALL  GETYX(W1,PHI,JNY,JNX) 

CALL  GETYX  ( INAME ( ' VPOR ' ) , GVPR , JNY , JNX ) 
DO  19620  IX=1,NX 
DO  19620  IY=1,NY 

IF  (GVPR(IY,IX) .LE.l .E-4)  GOTO  19620 
IF.(PHI(IY,IX)  .GT.XWIMAX)  THEN 
XW1MAX=PHI(IY.IX) 

IXWMAX=IX 

IYWMAX*IY 

IZWMAX=IZ 

ENDIF 

IF{PHI(IY,IX) .LT.XWIMIN)  THEN 
XW1MIN=PHI(IY,IX) 

IXWMIN=IX 

IYWMIN=IY 

IZWMIN=IZ 

ENDIF 

19620  CONTINUE 

CALL  GETYX (KE, PHI, JNY, JNX) 

CALL  GETYX  ( INAME ( ' VPOR ' ) , GVPR , JNY , JNX ) 
DO  19621  IX=1,NX 
DO  19621  IY=1,NY 

IF  (GVPR(IY,IX) .LE.l.E-4)  GOTO  19621 
IF { PHI ( lY , IX ) . GT . XKEMAX )  THEN 
XKEMAX=PHI(IY,IX) 

IXKMAX=IX 

IYKMAX=IY 

IZKMAX=IZ 

ENDIF 

IF(PHI(IY,IX) .LT.XKEMIN)  THEN 
XKEMIN=PHI{IY,IX) 

IXKMIN=IX 

IYKMIN=IY 

IZKMIN=IZ 

ENDIF 

*9621  CONTINUE 
C 

CALL  GETYX(EP,PHI,JNY,JNX) 

CALL  GETYX  ( INAME ( ' VPOR ' ) , GVPR , JNY , JNX ) 
DO  19622  IX=1,NX 
DO  19622  IY*1,NY 

IF  ( GVPR (lY, IX) .LE.l.E-4)  GOTO  19622 
IF(PHI(IY,IX) .GT.XEPMAX)  THEN 
XEPMAX=PHI { lY , IX ) 

IXEMAX*IX 

IYEMAX=IY 

IZEMAX=IZ 

ENDIF 

IF  (  PHI  ( lY ,  IX )  .  LT .  XEPMIN  )  THEN 
XEPMIN=PHI(IY,IX) 

IXEMIN=IX 

IYEMIN=IY 

IZEMIN=IZ 

ENDIF 

9622  CONTINUE 


CALL  GETYX(H1 ,PHI,JNY,JNX) 

CALL  GETYX  { INAME ( ' VPOR ' ) , GVPR , JNY , JNX ) 
DO  19623  IX=1,NX 
DO  19623  IY=1,NY 

IF  (GVPR(iy,IX) .LE.l .E-4)  GOTO  19623 
IF(PHI(IY,IX) .GT.XHIMAX)  THEN 
XH1MAX=PHI(IY,IX) 

IXHMAX=IX 
IYHMAX=IY 
•  IZHMAX=I2 
ENDIF 

IF(PHI(IY,IX) .LT.XHIMIN)  THEN 
XH1MIN=PHI{IY,IX) 

IXHMIN=IX 

IYHMIN=IY 

IZHMIN=I2 

ENDIF 

19623  CONTINUE 

C 

CALL  GETYX (TEMP, PHI, JNY, JNX) 

CALL  GETYX  ( INAME ( ' VPOR ' ) , GVPR , JNY , JNX ) 
DO  19624  IX=1,NX 
DO  19624  IY=1,NY 

IF  ( GVPR (lY, IX) .LE.l. E-4)  GOTO  19624 
IF(PHI(IY,IX) .GT.XTIMAX)  THEN 
XT1MAX=PHI(IY,IX) 

IXTMAX=IX 

IYTMAX=IY 

IZTMAX=I2 

ENDIF 

IF(PHI(IY,IX) .LT.XTIMIN)  THEN 
XT1MIN=PHI(IY,IX) 

IXTMIN=IX 

IYTMIN=IY 

IZTMIN=I2 

ENDIF 

19624  CONTINUE 

C 

CALL  GETYX (AUX( VIST ), PHI, JNY, JNX) 

CALL  GETYX  ( INAME ( ' VPOR ' ) , GVPR , JNY , JNX ) 
DO  19625  IX=1,NX 
DO  19625  IY*1,NY 

IF  ( GVPR (lY, IX) .LE.l. E-4)  GOTO  19625 
IF(PHI(IY,IX) .GT.XETMAX)  THEN 
XETMAX«PHI(IY,IX) 

IXXMAX=IX 

IYXMAX=IY 

IZXMAX=IZ 

ENDIF 

IF ( PHI ( lY , IX ) . LT . XETMIN )  THEN 
XETMIN*PHI (IY,IX) 

IXXMIN=IX 

IYXMIN=IY 

IZXMIN*=IZ 

ENDIF 

19625  CONTINUE 
ENDIF 

r* 

C-pd - Get  monitoring  values - 


c 

IF ( MOD ( ISWEEP , TSTSWP ) . NE . 0 )  GOTO  19692 

IF(IZ.NE.IZMONl)  GOTO  1962 

CALL  GETONE(Pl,PPl,IYMONl,IXMONl) 

CALL  GETONE(Ul,UUl,IYMONl,IXMONl) 

CALL  GETONE(Vl,VVl,IYMONl,IXMONl ) 

CALL  GETONE(Wl,WWl,IYMONl,IXMONl) 

CALL  GETONE ( AUX ( DENI ) , DDl , lYMONl , IXMONl ) 

IF ( STORE ( KE ) )  CALL  GETONE ( KE , KEl , lYMONl , IXMONl ) 

IF ( STORE ( EP ) )  CALL  GETONE ( EP, EPl , lYMONl , IXMONl ) 

IF ( STORE { AUX ( VIST ) ) )  CALL  GETONE ( AUX ( VIST ) , ETl , lYMONl , IXMONl ) 
CALL  GETONE ( Cl, ClCl, lYMONl, IXMONl) 

IF ( STORE ( C2 ) )  CALL  GETONE (C2 ,C2C1 , lYMONl , IXMONl ) 

IF ( STORE ( C3 ) )  CALL  GETONE ( C3 ,C3C1 , lYMONl , IXMONl ) 

IF ( STORE ( CP ) )  CALL  GETONE ( CP , CPCl , lYMONl , IXMONl ) 

IF(STORE(Cll) )  CALL  GETONE ( Cl 1 ,CXC1 , lYMONl , IXMONl ) 

CALL  GETONE ( TEMP , C4C1 , lYMONl , IXMONl ) 

CALL  GETONE ( HI , HlHl , lYMONl , IXMONl ) 

1962  IF(IZ.NE.IZMON2)  GOTO  1963 

CALL  GETONE ( PI, PP2,IYMON2,IXMON2) 

CALL  GETONE (U1,UU2,IYMON2,IXMON2) 

CALL  GETONE ( VI , VV2 , IYMON2 , IXMON2 ) 

CALL  GETONE ( W1 , WW2 , I YMON2 , IXMON2 ) 

CALL  GETONE ( AUX ( DENI ) , DD2 , IYMON2 , IXMON2 ) 

IF ( STORE ( KE ) )  CALL  GETONE ( KE , KE2 , IYMON2 , IXMON2 ) 

IF ( STORE ( EP ) )  CALL  GETONE ( EP,EP2 , IYMON2 , IXMON2 ) 

IF (STORE (AUX ( VIST) ) )  CALL  GETONE (AUX ( VIST ), ET2 , IYMON2 , IXMON2 ) 
CALL  GETONE ( Cl, C1C2,IYM0N2,IXM0N2) 

IF ( STORE ( C2 ) )  CALL  GETONE ( C2 , C2C2 , I YMON2 , IXMON2 ) 

IF ( STORE ( C3 ) )  CALL  GETONE (C3,C3C2,IYMON2,IXMON2) 

IF ( STORE ( CP ) )  CALL  GETONE ( CP , CPC2 , IYMON2 , IXMON2 ) 

IF ( STORE (Cll))  CALL  GETONE(Cll ,CXC2 , IYMON2 , IXMON2 ) 

CALL  GETONE ( TEMP , C4C2 , IYMON2 , IXMON2 ) 

CALL  GETONE ( HI , H1H2 , IYMON2 , IXMON2 ) 

1963  IF(IZ.NE.IZMON3)  GOTO  1964 

CALL  GETONE ( PI, PP3,IYMON3,IXMON3) 

CALL  GETONE (Ul,UU3,IYMON3,IXMON3) 

CALL  GETONE ( VI, VV3,IYMON3,IXMON3) 

CALL  GETONE (Wl,WW3,iyMON3,IXMON3) 

CALL  GETONE ( AUX ( DENI ) , DD3 , IYMON3 , IXMON3 ) 

IF ( STORE ( KE ) )  CALL  GETONE ( KE, KE3 , IYMON3 , IXMON3 ) 

IF ( STORE ( EP ) )  CALL  GETONE ( EP , EP3 , IYMON3 , IXMON3 ) 

IF ( STORE ( AUX ( VIST ) ) )  CALL  GETONE ( AUX ( VIST ) , ET3 , IYMON3 , IXMON3 ) 
CALL  GETONE ( Cl, C1C3,IYM0N3,IXM0N3) 

IF ( STORE ( C2  ) )  CALL  GETONE ( C2 , C2C3 , 1 YMON3 , IXMON3 ) 

IF(STORE(C3) )  CALL  GETONE ( C3 ,C3C3 , I YMON3 , IXMON3 ) 

IF ( STORE ( CP ) )  CALL  GETONE ( CP , CPC3 , IYMON3 , IXMON3 ) 

IF ( STORE ( Cll ) )  CALL  GETONE(Cll ,CXC3 , IYMON3 , IXMON3 ) 

CALL  GETONE ( TEMP , C4C3 , IYMON3 , IXMON3 ) 

CALL  GETONE ( HI, H1H3 ,IYMON3,IXMON3) 

1964  IF(IZ.NE.IZMON4)  GOTO  1965 

CALL  GETONE ( PI, PP4,IYMON4,IXMON4) 

CALL  GETONE ( U1 , UU4 , IYMON4 , IXMON4 ) 

CALL  GETONE(V1,VV4,IYMON4,IXMON4) 

CALL  GET0NE(W1,WW4,IYM0N4,IXM0N4) 

CALL  GETONE ( AUX ( DENI ) , DD4 , IYMON4 , IXMON4 ) 

IF(ST0RE(KE) )  CALL  GETONE(KE,KE4 , iyMON4 , IXMON4 ) 

IF f STORE (EP) )  CALL  GETONE f EP , EP4 , IYMON4 , IXMON4 ^ 

IF (STORE (AUX (VIST)  }  )  CALL  GETONE ( AUX f VIST )  , ET4 , IYM0N4 , IXMON4  ■ 
CALL  GETONE ( Cl , C1C4 , IYMON4 , IXMON4 ) 


IF ( STORE ( C2 ) )  CALL  GETONE ( C2 , C2C4 . IYMON4 , IXMON4 ) 

IF ( STORE ( C3  )  )  CALL  GETONE ( C3 ,C3C4 , iyMON4 , IXMON4 ) 

IF ( STORE (CP))  CALL  GETONE ( CP , CPC4 , iyMON4 , IXMON4 ) 

IF ( STORE ( Cll )  )  CALL  GETONE ( Cl 1 ,CXC4 , iyMON4 , IXMON4 ) 

CALL  GETONE ( TEMP, C4C4, IYMON4, IXMON4 ) 

CALL  GETONE ( HI , H1H4 , IYMON4 , IXMON4 ) 

1965  IF(IZ.NE.IZMON5)  GOTO  1966 

CALL  GETONE ( PI, PP5,IYMON5,IXMON5) 

CALL  GETONE (Ul,UU5,IYMON5,IXMON5) 

CALL  GETONE  ( VI ,  W5  ,  IYMON5  ,  IXMON5  ) 

CALL  GETONE ( W1 , WW5 , I YMON5 , IXMON5 ) 

CALL  GETONE  ( AUX  ( DENI )  ,  DDS  ,  IYMON5 ,  IXMON5  ) 

IF ( STORE ( KE ) )  CALL  GETONE ( KE , KE5 , I YMON5 , IXMON5 ) 

IF ( STORE ( EP ) )  CALL  GETONE ( EP ,EP5 , IYMON5 , IXMON5 ) 

IF  ( STORE  ( AUX  ( VIST )  )  )  CALL  GETONE  ( AUX  ( VIST )  ,  ET5 , 1 YMON5  ,  IXMON5  ) 
CALL  GETONE ( Cl, C1C5,IYM0N5,IXM0N5) 

IF ( STORE ( C2 ) )  CALL  GETONE ( C2 , C2C5 , IYMON5 , IXMON5 ) 

IF { STORE ( C3 )  )  CALL  GETONE ( C3 , C3C5 , IYMON5 , IXMON5 ) 

IF ( STORE ( CP )  )  CALL  GETONE ( CP , CPC5 , 1 YMON5 , IXMON5 ) 

IF(STORE(Cll) )  CALL  GETONE (Cll ,CXC5 , IYMON5 , IXMON5 ) 

CALL  GETONE ( TEMP , C4C5 , I YMON5 , IXMON5 ) 

CALL  GET0NE(H1,H1H5,IYM0N5,IXM0N5' 

1966  IF(IZ.NE.IZMON6)  GOTO  1967 

CALL  GETONE (P1,PP 6, IYMON6,IXMON6) 

CALL  GETONE ( U1 , UU6 , IYMON6 , IXMON6 ) 

CALL  GETONE ( VI , VV6 , IYMON6 , IXMON6 ) 

CALL  GETONE ( W1 , WW6 , IYMON6 , IXMON6 ) 

CALL  GETONE  ( AUX  ( DENI )  ,  DD6 , 1 YMON6  ,  IXMON6  ) 

IF ( STORE ( KE )  )  CALL  GETONE ( KE , KE6 , 1 YMON6 , 1 XMON6 ) 

IF ( STORE ( EP ) )  CALL  GETONE (EP ,EP6 , IYMON6 , IXMON6 ) 

IF (STORE (AUX ( VIST)  )  )  CALL  GETONE(AUX( VIST ) ,ET6 , IYMON6 , IXMON6 ) 
CALL  GETONE ( Cl , C1C6 , IYMON6 , IXMON6 ) 

IF ( STORE ( C2 ) )  CALL  GETONE ( C2 , C2C6 , IYMON6 , IXMON6 ) 

IF ( STORE ( C3  )  )  CALL  GETONE ( C3 , C3C6 , 1 YMON6 , IXMON6 ) 

IF ( STORE ( CP ) )  CALL  GETONE ( CP, CPC6 ,IYMON6 , IXMON6 ) 

IF ( STORE ( Cll )  )  CALL  GETONE ( Cll ,CXC6 , 1 YMON6 , IXMON6 ) 

CALL  GETONE ( TEMP , C4C6 , iyMON6 , IXMON6 ) 

CALL  GETONE ( HI, HlH6,iyMON6,IXMON6) 

1967  IF(IZ.NE.IZMON7)  GOTO  1968 

CALL  GETONE ( PI, PP7,IYMON7,IXMON7) 

CALL  GETONE (Ul,UU7,iyMON7,IXMON7) 

CALL  GETONE ( VI, VV7,IYMON7,IXMON7) 

CALL  GETONE ( W1 , WW7 , I YMON7 , IXMON7 ) 

CALL  GETONE  ( AUX  ( DENI )  ,  DD7  ,  lYMONT  ,  IXMON7  ) 

IF ( STORE ( KE ) )  CALL  GETONE ( KE , KE7 , IYMON7 , IXMON7 ) 

IF ( STORE ( EP ) )  CALL  GETONE ( EP , EP7 , iyMON7 , IXMON7 ) 
IF(STORE(AUX(VIST)  )  )  CALL  GETONE( AUX (VIST ) ,ET7 , IYMON7 , IXMON7 ) 
CALL  GETONE ( Cl , C1C7 , IYMON7 , IXMON7 ) 

IF ( STORE ( C2  )  )  CALL  GETONE ( C2 , C2C7 , 1 YMON7 , IXMON7 ) 

IF ( STORE ( C3  )  )  CALL  GETONE ( C3 , C3C7 , 1 YMON7 , IXMON7 ) 

IF ( STORE ( CP )  )  CALL  GETONE ( CP , CPC7 , 1 YMON7 , IXMON' ) 

IF ( STORE ( Cll )  )  CALL  GETONE ( Cll ,CXC7 , 1 YMON7 , IXMON7 ) 

CALL  GETONE ( TEMP , C4C7 , IYMON7 , IXM0K7 ) 

CALL  GETONE ( HI , H1H7 , IYMON7 , IXMON7 i 

1968  IF(IZ.NE.IZMON8)  GOTO  1969 

CALL  GETONE ( PI ,PP8,IYMON8,IXMON8) 

CALL  GETONE ( U1 , UU8 , IYMON8 , IXMON8 ) 

CALL  GETONE ( VI , VV8 , IYMON8 , IXMON8 ) 

CALL  GETONE (W1 ,WWe , lYMONS , IXKON8 i 
CALL  GETONE ( AUX ( DENI ) , DDS , I YMON8 , IXMON8 . 


IF ( STORE ( KE ) )  CALL  GETONE ( KE , KE8 , I YMONS , I XMON8 ) 

IP ( STORE ( EP ) )  CALL  GETONE { EP, EP8 , IYMON8 , IXMON8 ) 

IF ( STORE ( AUX ( VIST ) ) )  CALL  GETONE ( AUX ( VIST ) , ET8 , I YMON8 , IXMON8 ) 
CALL.  GETONE ( Cl , C1C8 , IYMON8 , IXMON8 ) 

IF ( STORE ( C2 ) )  CALL  GETONE ( C2 , C2C8 , I YMON8 , IXMON8 ) 

IF(STORE(C3) )  CALL  GETONE ( C3 ,C3C8 , IYMON8 , IXMON8 ) 

IF  ( STORE  ( CP  )  )  CALL  GETONE  ( CP ,  CPC8 , 1 YMON8  ,  IXMON8 ') 

IP(STORE(Cll) )  CALL  GETONE ( Cll ,CXC8 , IYMON8 , IXMON8 ) 

CALL  GETONE ( TEMP , C4C8 , IYMON8 , IXMON8 ) 

CALL  GETONE ( HI ,H1H8,IYM0N8,IXM0N8) 

1969  IF(I2.NE.IZMON9)  GOTO  19691 

CALL  GETONE ( PI , PP9 , IYMON9 , IXMON9 ) 

CALL  GETONE ( U1 , UU9 , I YMON9 , IXMON9 ) 

CALL  GETONE ( VI, VV9,IYMON9,IXMON9) 

CALL  GETONE ( W1 , WW9 , I YMON9 , IXMON9 ) 

CALL  GETONE ( AUX ( DENI ) , DD9 , IYMON9 , IXMON9 ) 

IP ( STORE ( KE ) )  CALL  GETONE ( KE , KE9 , I YMON9 , IXMON9 ) 

IP ( STORE { EP ) )  CALL  GETONE ( EP ,EP9 , IYMON9 , IXMON9 ) 

IP ( STORE ( AUX ( VIST ) ) )  CALL  GETONE { AUX ( VIST ) , ET9 , IYM09 1 , IXMON9 ) 
CALL  GETONE ( Cl , C1C9 , IYMON9 , IXMON9 ) 

IF ( STORE { C2 ) )  CALL  GETONE ( C2 , C2C9 , IYMON9 , IXMON9 ) 

IF ( STORE ( C3 ) )  CALL  GETONE ( C3 ,C3C9 , IYMON9 , IXMON9 ) 

IF ( STORE ( CP ) )  CALL  GETONE ( CP , CPC9 , IYMON9 , IXMON9 ) 

IF ( STORE ( Cll ) )  CALL  GETONE ( Cll .CXC9 , I YMON9 , IXMON9 ) 

CALL  GETONE ( TEMP , C4C9 , IYMON9 , IXMON9 ) 

■  CALL  GETONE ( HI, H1H9,IYM0N9,IXM0N9) 

.9691  IF(I2.NE.IZMON10)  GOTO  19692 

CALL  GETONE(P1,PP10,IYMON10,IXMON10)  ’ 

CALL  GETONE  ( U1 ,  UUl  0  ,  lYMONl  0  ,  IXMONl  0  )• 

CALL  GETONE  ( VI ,  Wl  0 ,  lYMONl 0  ,  IXMONl  0  ) 

CALL  GETONE ( W1 , WWl 0 , lYMONl 0 . IXMONl 0 ) 

•  CALL  GETONE(AUX(DENl) ,DD10, lYMONl 0, IXMONl 0) 

IF(STORE(KE) )  CALL  GETONE ( KE ,KE10 , lYMONl 0 , IXMONl 0 ) 

IP(STORE(EP) )  CALL  GETONE (EP,EP10 , lYMONl 0 , IXMONl 0 ) 
IF(STORE(AUX(VIST) ) )  CALL  GETONE(AUX( VIST ) ,ET10 , lYMONl 0 , IXMONl 0 ) 
CALL  GETONE ( Cl , ClCl 0 , lYMONl 0 , IXMONl 0 ) 

IF ( STORE ( C2 ) )  CALL  GETONE ( C2 ,C2C10 , lYMONTO , IXMONl 0 ) 

IP ( STORE { C3 ) )  CALL  GETONE ( C3 , C3C1 0 , lYMONl 0  ,  IXMONl 0 ) 

IF ( STORE ( CP )  )  CALL  GETONE ( CP ,CPC10 , lYMONl 0 , IXMONl 0 ) 

IF ( STORE ( Cll )  )  CALL  GETONE ( Cll ,CXC10 , lYMONl 0 , IXMONl 0 ) 

CALL  GETONE ( TEMP , C4C1 0 , lYMONl 0 , IXMONl 0 ) 

CALL  GETONE ( HI , HlHl 0 , lYMONl 0 , IXMONl 0 ) 

.9692  CONTINUE 


RETURN 
197  CONTINUE 
* _ 


SECTION  7  -  FINISH  OF  SWEEP. 


C-pd - Printout  of  monitoring  locations- 


:F(M0D(I5WEEP,TSTSWP) .EQ.0.AND.IG(38) .EQ.l)  WRITE ( 6 , 1977 ) 
IXMONl , lYMONl, IZM0N1,PP1, UUl, VVl, WWl, DDl , 

IXMON2 , I YMON2 , IZMON2 , PP2 , UU2 , VV2 . WW2 , DD2 , 

I XMCN  3 , 1 YMON  3 , 1 ZMON  3 , PP  3 , UU  3 , VV  3 , WW  3 , DD  3 , 

IXMON4 , IYMON4 , IZMON4 , PP4 , UU4 , VV4 , WW4 , DD4 , 

IXMON5 , IYMON5 , I ZMON5 , PP5 , UU5 /VV5 , WW5 , DD5 , 

IXMON6 , I YMON6 , IZMON6 , PP6 , UU6 , VV6 , WW6 , DD6 , 

IXMON7 ,IYMON7 , IZMON7 , PP7 , UU7 , VV7 , WW7 , DD7 , 

IXMON6  ,  IYMO!.'6  ,  IZKON6  ,  PP8  ,  UUB  ,  VV8  ,  WW8  ,  DD  e  , 

IXMON9 , IYMON9 , IZMON9 ,PP9 .UU9 ,VV9 ,WW9 ,DD9 , 


Si  IXMONIO  ,  lYMONlO  ,  IZMONIO  ,  PPIO  ,UU10  ,  VVIO  ,  WWIO  ,DD10 

1977  FORMAT ( IX, 'MONITORING  VALUES  : ' 2X , ' PI ' , IIX , ' U1 ' . IIX , ' VI ' , 1 IX , 

&  'Wl' ,10X, 'RH01'/,10(1X, 'AT( ' ,12, ' , '12, ' , '12, ' ) : '1P,5E13.5: ,/ ) ) 
IP(MOD(ISWEEP,TSTSWP) .EQ. 0 . AND. IG( 39 ) .EQ.l)  WRITE ( 6 , 1978 ) 

&  IXMONl , lYMONl , IZMONl , KEl , EPl , ClCl , ETl , C4C1 , 

&  IXMON2,IYMON2,IZMON2,KE2,EP2,ClC2,ET2,C4C2, 

&  IXMON3 , IYMON3 , IZMON3 ,KE3 ,EP3 ,C1C3 ,ET3 ,C4C3 , 

6c  IXMON4 , 1 YMON4  ,  IZMON4  ,  KE4  ,  EP4  ,  C1C4  ,  ET4  ,  C4C4  , 

6c  IXMON5  ,  IYMON5  ,  IZMON5  ,  KE5  ,  EPS  , C1C5 ,  ET5  ,  C4C5  , 

5c  IXMON6  ,  IYMON6  ,  IZMON6  ,  KE6  ,  EP6  ,  C1C6  ,  ET6  ,  C4C6  , 

6c  IXMON7  ,  IYMON7  ,  IZMON7  ,  KE7  ,  EP7  ,  C1C7  ,  ET7  ,  C4C7  , 

6c  IXMON8  ,  IYMON8  ,  IZMON8  ,  KE8  ,  EP8  , C1C8 ,  ET8 ,  C4C8  , 

6c  IXMON9 , 1 YMON9  ,  IZMON9  ,  KE9  ,  EP9  ,  C1C9  ,  ET9  ,  C4C9  , 

6c  IXMONl 0 , 1 YMONl 0  ,  IZMONl  0  ,  KEl  0  ,  EPIO ,  ClCl 0  ,  ETl  0 ,  C4C1 0 

1978  FORMAT( IX, 'MONITORING  VALUES  : ' 2X, 'KE' , IIX , 'EP ' , IIX , ' Cl ' , lOX, 

5c  'ENUT'  ,9X,  'TEMP'/,  10  (IX,  'LO  (  ' ,  12 ,  '  ,  '  12 ,  '  ,  '  12  ,  '  )  :  '  IP ,  5E1 3 . 5  :  ,  /  )  ) 

IP(MOD(ISWEEP,TSTSWP) .EQ . 0 . AND . IG( 40 ) .EQ.l)  WRITE ( 6 , 1979 ) 

6c  IXMONl ,  I  YMONl ,  IZMONl  ,H1H1  ,C2C1  ,C3C1  ,CPC1  ,CXC1 , 

6c  IXMON2 , 1 YMON2  ,  IZMON2  ,  H1H2  ,  C2C2 ,  C3C2 ,  CPC2  ,  CXC2  , 

6c  IXMON3  ,  IYMON3  ,  IZMON3  ,H1H3  ,C2C3  ,C3C3  ,CPC3  ,CXC3  , 

6c  IXMON4 , 1 YMON4  ,  IZMON4  ,  H1H4  ,  C2C4  ,  C3C4  ,  CPC4  ,  CXC4  , 

5c  IXMON5 , 1 YMON5  ,  IZMON5  ,  H1H5  ,  C2C5 ,  C3C5 ,  CPC5  ,  CXC5  , 

6c  IXMON6  ,  IYMON6  ,  IZMON6  , H1H6  ,  C2C6  ,  C3C6  ,  CPC6  ,  CXC6  , 

6c  IXMON7  ,  IYMON7  ,  IZMON7  ,H1H7  ,C2C7  ,C3C7  ,  CPC7  ,  CXC7  , 

6c  IXMON8  ,  IYMON8  ,  IZMON8  ,  H1H8  ,C2C8  ,C3C8  ,  CPCB  ,  CXC8  , 

6c  IXMON9  ,  IYMON9  ,  IZMON9  ,  H1H9  ,  C2C9  ,  C3C9  ,  CPC9  ,  CXC9  , 

&  IXMONl 0 , I YMONl 0 , IZMONl 0 , HlHl 0 , C2C1 0 , C3C1 0 , CPCl 0 , CXCl 0 

1979  FORMAT( IX, 'MONITORING  VALUES  : ' 2X , 'HI ' , IIX , ' C2 ' , IIX , ' C3 ' , IIX , 

6  'CP' ,10X, 'SPAR'/,10(1X, 'PT( ' , 12 , ' , ' 12 , ' , ' 12 , ' IP , 5E1 3 . 5 : , / ) ) 

C 

C-od - Printout  heat  info - 

C 

IF  (IG(41 ) .EQ.l )  THEN 

CALL  GETSOR ( ' HEATTRIE ' , HI , QDOTl ) 

CALL  GETSOR  (  '  HEATTRIV.  '  ,  HI ,  QDOT2 ) 

CALL  GETSOR ( ' HEATTRIN ' , HI , QDOT3 ) 

CALL  GETSOR ( 'HEATTRIS ' ,H1 ,QDOT4 ) 

CALL  WRITBL 

CALL  WRIT4R('  Qdot  1  ' ,QDOTl , ' ,Qdot  2  ',QDQT2, 

6.  ',Qdot  3  '  ,0DOT3,  '  ,0dot  4  '  ,  QDOT4  ) 

ENDIF 

C 

C-pd - Printout  sore  and  calc  pumping  ratio - 

C 

IF(MOD(ISWEEP,NPRMON) . EQ . 0 .OR .MOD( ISWEEP , IG ( 901 ) ) .EQ.O)  THEN 
CALL  GETSOR (  ' XOPEN2A ' , R1 , XMDOT2A ) 

CALL  GETSOR ( ' XOPEN2B ' , R1 , XMDOT2B ) 

CALL  GETSOR ( 'XOPEN2C' ,R1 ,XMDOT2C) 

CALL  GETSOR ( ' XOPEN2D ' , R1 , XMDOT2D ) 

CALL  GETSOR ( ' XENGOUT ' , El , XMDOT3 ) 

CALL  GETSOR ( ' XOPEN3 ' ,  R1 , XMDOT4 ) 

CALL  GETSOR ( ' XENGIN ' ,  R1 , XMDOT6 ) 

CALL  GETSOR ( ' XOPENl ' ,  R1 , XMDOT7 ) 

CALL  GETSOR ( ' XENGOUT ' , Wl , XWVELl ) 

CALL  GETSOR ( ' ZPROP ' ,  Wl , XWVEL2 ) 

XMDOT2  =  XMDOT  2 A+XMDOT  2B+ XMDOT2C+XMDOT  2D  • 

XPR2= ( -XMDOT4-XMDOT3 ) /XMDOT 3 

XERR1=RESD(P1 )*RESREFfPl )*RG(701 ) *100 . 0/XMDOT7 
C  XEF.R2  =  RE3D(  Wl  )  *RESREF  ;W1  y’^lCC  .  0/  ;  XWVELl -c-XVVELl  , 

XEfiR2=RESD(Wl )*RESREF(W1 ) *100.0/ (XWVEL1+XWVEL2 ) 


XFUL= ( XMDOT3+XMDOT6 ) /RG( 35 ) 

XMBAL=XMDOT7+XMDOT2+XMDOT4+RG( 702 ) 

IF ( MOD ( ISWEEP , NPRMON ) . EQ . 0 )  THEN 

CALL  WRIT4R('  Mdot  1  ' , XMDOT7 , ' , Mdot  2  ',XMDOT2, 

&  ' ,Mdot  3  ' ,XMDOT4, ' ,Mdot  4  ',XMDOT3) 

CALL  WRITIR ( '  PR  Eng  ' , XPR2 ) 

CALLWRIT2R('  ENG  IN' ,XMDOT6/RG ( 35 ) , ' , ENG  OUT ' , XMDOT3/RG ( 3 5  )  ) 
CALL  WRITIR ( '  FUEL  IN ' , XFUL ) 

CALLWRIT2R('  ErrMdot ' ,XERR1 , ' ,ErrVel  ',XERR2) 

CALL  WRITIR ( '  SUM  MAS ' , XMBAL ) 

ENDIF 

C- 

IF(MOD(ISWEEP,IG(901) ) .EQ.O)  THEN 
CALL  GETSOR ( ' XOPEN2 ' ,  HI , XEDOT2 ) 

CALL  GETSOR ( ' XENGOUT ' . HI , XEDOT  3 ) 

CALL  GETSOR ( ' XOPEN3 ' ,  HI , XEDOT4 ) 

CALL  GETSOR ( ' XENGIN ' ,  HI , XEDOT 6 ) 

CALL  GETSOR ( ' XOPENl ' ,  HI , XEDOT7 ) 

XECON=9 .47831E-04 
CALL  WRITBL 

CALL  RUSHL(XMDOT7/RG( 35) ,XMDOT2/RG( 35) , XMDOT4/RG( 35 ) , 

&  XMDOT6/RG( 35) ,XMDOT3/RG( 35 ) , XFUL , XEDOT7*XECON, 

6.  XEDOT2*XECON ,  XEDOT4*XECON ,  XEDOT6*XECON , 

&  XEDOT3*XECON,XPR2,XERRl,XERR2,XMBAL/RG(35) ) 

CALL  WRITBL 
ENDIF 
ENDIF 
C 

C-pd - Printout  max  and  min - 

IP ( MOD ( ISWEEP , NPRMON ) . EQ . 0 )  THEN 

WRITE (6,*)'  PIMAX  LOC  ' ,XP1MAX, IXPMAX , lYPMAX , IZPMAX 
WRITE(6,*)'  PIMIN  LOC  ' ,XP1MIN, IXPMIN, lYPMIN, IZPMIN 
WRITE (6,*)'  UlMAX  LOC  ' ,XU1MAX , IXUMAX , lYUMAX , IZUMAX 
WRITE (6,*)'  UlMIN  LOC  ' ,XU1MIN, IXUMIN, lYUMIN, IZUMIN 
WRITE (6,*)'  VIMAX  LOC  ' ,XV1MAX , IXVMAX , lYVMAX , IZVMAX 
WRITE (6,*)'  VIMIN  LOC  ' ,XV1MIN, IXVMIN, lYVMIN, IZVMIN 
WRITE (6,*)'  WIMAX  LOC  ' ,XW1MAX, IXWMAX , lYWMAX , IZWMAX 
WRITE (6,*)'  WIMIN  LOC  ' ,XW1MIN, IXWMIN, lYWMIN, IZWMIN 
WRITE (6,*)'  HIMAX  LOC  ' ,XH1MAX, IXHMAX , lYHMAX , IZHMAX 
WRITE (6,*)'  HIMIN  LOC  ' ,XH1MIN, IXHMIN, lYHMIN, IZHMIN 
WRITE ( 6  ,  *  )  '  TIMAX  LOC  ' , XTIMAX , IXTMAX , I YTMAX , IZTMAX 
WRITE(6,*)'  TIMIN  LOC  ' ,XT1MIN, IXTMIN , lYTMIN , IZTMIN 
WRITE(6,*)'  KEMAX  LOC  ' ,XKEMAX, IXKMAX , lYKMAX , IZKMAX 
C  WRITE (6,*)'  KEMIN  LOC  ' ,XKEMIN, IXKMIN, lYKMIN , IZKMIN 

WRITE ( 6  ,  *  )  '  EPMAX  LOC  ' , XEPMAX , I XEMAX , I YEMAX , I ZEMAX 

C  WRITE (6,*)'  EPMIN  LOC  ' ,XEPMIN, IXEMIN, lYEMIN, IZEMIN 

WRITE(6,*)'  ETMAX  LOC  ' ,XETMAX, IXXMAX , lYXMAX , IZXMAX 
C  WRITE (6,*)'  ETMIN  LOC  ' ,XETMIN, IXXMIN , I YXMIN , IZXMIN 

ENDIF 

IF(ISWEEP.E0.FSWEEP+2 )  NPRMON=INPR 

IF ( MOD ( ISWEEP, TSTSWP ) .NE.O)  WRITE(6,*)'  ISWEEP  =  ISWEEP 

C-pd - Printout  heat  total - 

C 

IF ( ISWEEP. EQ.LSWEEP. OR. MOD ( ISWEEP, IG( 901 )  ) , EQ . 0 )  THEN 
CALL  WRITBL 

CALL  WRITIR ( ' Qdot , Tot ' , QDTTOT ) 

CALL  WRIT4R('  QTOT  1  ' , QDOTOl , ' , QTCT  1  ',;COTC2, 

6.  ',QTOT  3  '  ,QDOT03  ,  '  ,QTGT  4  '  .  2DOT04  ) 


u  O  U  O  O  CJ 


QDTTOT-O.O 
ODOT01«0.0 
OnOT02»0.0 
Q~K)T03-0.0 
0DOT04*0.0 
CALL  writBL 
ENDIF 

-pd - Check  to  stop  run - 

INQUIRE (FILES 'ABORT' ,EXIST=LSG1 ) 

IF(LSGl)  THEN 

OPEN  (91,  FILES  '  abort  '  ) 

CLOSE (91, STATUS* ' DELETE ' ) 

LSWEEPsiSWEEP+2 

WRITE (6,*)'  ==>  ABORT  CALLED:  STOP  IN  2  SWEEPS  ' 

LSGls. false. 

ENDIF 

-pd - Modify  relaxation  without  killing  run - 

INQUIRE ( FILE* ' RELAX? ' , EXIST=LSG2 ) 

IF(LSG2)  THEN 

OPEN (92, FILE* ' RELAX? ' ) 

WRITE (6,*)'  ==>  MODIFYING  RELAX  PI  OLD  VALVE*', 

&  DTFALS ( PI ) 

READ(92,1971)XRELP1 
DTFALS ( PI )sXRELPl 
CLOSE( 9 2, STATUS* 'DELETE' ) 

WRITE  (6,*)'  s«>  ISWEEP  S.  NEW  VALVE* '  , 

&  DTFALS ( PI ), ISWEEP 

■ ITSTsTSTSWP 
TSTSWP=1 
lOPENsl 
LSG2*. FALSE. 

ENDIF 

INQUIRE ( FILE* ' RELAXT ' , EXIST=LSG3 ) 

IF(LSG3)  THEN 

OPEN (93, FILE* ' RELAXT ' ) 

WRITE (6,*)'  =*>  MODIFYING  RELAX  KE  &  EP  OLD  VALVES*', 
&  DTFALS ( KE ) , DTFALS ( EP ) 

READ ( 9 3 , 1 9 7 2 ) XRELKE , XRELEP 
DTFALS ( KE ) * XRELKE 
DTFALS ( EP ) s XRELEP 
CLOSE (93, STATUS* ' DELETE ' ) 

WRITE ( 6 , * )  '  =*>  ISWEEP  &  NEW  VALVES* '  , 

&  DTFALS ( KE ) , DTFALS ( EP ) , ISWEEP 

IF(IOPEN.EQ.O)  THEN 
ITST*TSTSWP 
TSTSWP*! 

IOPEN=l 

ENDIF 

LSG3* .FALSE. 

ENDIF 

INQUIRE ( FILE* 'RELAXS ' , EXIST*LSG4 ) 

IF(LSG4)  THEN 

OPEN  I  94 , FILE* ' RELAXS '  J 
IF ( SOLVE ( C2 ) )  THEN 


WRITE (6,*)'  *=>  MODIFYING  RELAX  HI  Cl  &  C2  OLD  VALVES= 
&  DTFALS(Hl) ,DTFALS(C1) ,DTFALS(C2) 

READ (94,1973) XRELHl , XRELCl , XRELC2 
DTFALS ( HI ) «XRELH1 
DTFALS ( Cl ) -XRELCl 
DTFALS ( C2 ) -XRELC2 

WRITE(6,*)'  ==>  ISWEEP  &  NEW  VALVES- 

&  DTFALS ( HI ) , DTFALS ( Cl ) , DTFALS ( C2 ) , ISWEEP 

ELSE 

WRITE (6,*)'  «>  MODIFYING  RELAX  HI  &  Cl  OLD  VALVES- 
&  DTFALS ( HI ) , DTFALS ( Cl ) 

READ (94,1972) XRELHl , XRELCl 
DTFALS ( HI ) -XRELHl 
DTFALS ( Cl ) -XRELCl 

WRITE (6,*)'  — >  ISWEEP  &  NEW  VALVES- 

&  DTFALS ( HI ) , DTFALS ( Cl ) , ISWEEP 

ENDIF 

CLOSE (94, STATUS- ' DELETE ' ) 

IF(IOPEN.EQ,0)  THEN 
ITST-TSTSWP 
TSTSWP-1 
IOPEN-1 
ENDIF 

LSG4-. FALSE, 

ENDIF 

INQUIRE ( FILE- ' RELAXV ' , EXIST-LSG5 ) 

IF(LSG5)  THEN 

OPEN (95, FILE- ' RELAXV ' ) 

WRITE (6,*)'  — >  MODIFYING  RELAX  U1  VI  &  W1  OLD  VALVES- 
&  DTFALS ( U1 ) , DTFALS ( VI ) , DTFALS ( W1 ) 

READ (95,1973) XRELUl , XRELVl , XRELWl 
DTFALS ( U1 ) -XRELUl 
DTFALS ( VI ) -XRELVl 
DTFALS ( W1 ) -XRELWl 

WRITE(6,*)'  — >  ISWEEP  E.  NEW  VALVES- 

&  DTFALS ( U1 ) , DTFALS ( VI ) , DTFALS ( W1 ) , ISWEEP 

CLOSE (95, STATUS- ' DELETE ' ) 

IFdOPEN.EQ.O)  THEN 
ITST-TSTSWP 
TSTSWP-1 
IOPEN-1 
ENDIF 

LSG5-. FALSE. 

ENDIF 

INQUIRE ( FILE- ' DUMPIT ' , EXIST-LSG6 ) 

IF(LSG6)  THEN 

OPEN ( 9 6 , FILE- ' DUMPIT ' ) 

CLOSE ( 96 , STATUS- ' DELETE ' ) 

CALL  AUTCHA( ISWEEP) 

LSG6* . FALSE . 

ELSEIF  ( MOD ( ISWEEP, IG( 902 M .EQ.O)  THEN 
CALL  AUTCHA( ISWEEP) 

ENDIF 

INQUIRE ( FILE- ' TSTMOD ' , EXIST-LSG7 ) 

IF(LSG7)  THEN 

OPEN (97, FILE- ' TSTMOD ' ) 

WRITEce,*)'  — >  MODIFYING  TSTSWP  OLD  VALVE- 


c 


c 


c 


&  TSTSWP 

READ( 97 , 1974 )TSTSWP 
IF(IOPEN.EQ.O)  THEN 
ITST*TSTSWP 
IOPEN»l 
ENDIF 

WRITE (6,*)'  *=>  ISWEEP  &  NEW  VALVE = ' 

E>  TSTSWP ,  ISWEEP 

CLOSE (97, STATUS* ' DELETE ' ) 

LSG7*. FALSE. 

ENDIF 

INQUIRE ( FILE* ' NPRMOD ' , EXIST=LSG8 ) 

IF(LSG8)  THEN 

OPEN (98, FILE* ' NPRMOD ' ) 

WRITE (6,*)'  **>  MODIFYING  NPRMON 
G.  NPRMON 

READ( 98 , 1974 )NPRMON 

WRITE  (6,*)'  **>  ISWEEP  Gi 

&  NPRMON, ISWEEP 

CLOSE (98, STATUS* ' DELETE ' ) 

LSG8* .FALSE. 

ENDIF 

INQUIRE ( FILE* ' IGGMOD ' , EXIST=LSG9 )  ' 

IF(LSG9)  THEN 

OPEN (99, FILE* ' IGGMOD ' ) 

WRITE (6,*)'  *=>  MODIFYING  IG( 38-41)  OLD  VALVES*' 

&  IG(38) ,IG(39) ,IG(40) ,IG(41) 

READ(99,1975)IG(38) ,IG(39) ,IG(40) ,IG(41) 

WRITE (6,*)'  *»>  ISWEEP  &  NEW  VALVES* ' 

&  IG(38) ,IG(39) , IG(  40 ) ,IG( 41) , ISWEEP 

CLOSE ( 99 , STATUS* ' DELETE ' ) 

LSG9*. FALSE. 

ENDIF 

INQUIRE ( FILE* ' ML2MOD ' , EXIST*LSG9 ) 

IF(LSG9)  THEN 

OPEN (100, FILE* 'ML2MOD' ) 

WRITE (6,*)'  *=>  MODIFYING  IXYZMON2 
S.  IXMON2  ,  IYMON2  ,  IZMON2 

READ (100,1976) IXMON2 , I YMON2 , I ZMON2 
WRITE (6,*)'  »«>  ISWEEP  & 

£t  IXMON2,IYMON2,IZMON2,ISWEEP 

CLOSE (100, STATUS- ' DELETE ' ) 

LSG9*. FALSE. 

ENDIF 

INQUIRE ( FILE* ' ML3MOD ' , EXIST-LSG9 ) 

IF(LSG9)  THEN 

OPEN (101, FILE* ' ML  3MOD ' ) 

WRITEf6,*)'  =*>  MODIFYING  IXYZMON3 
S.  IXMON3,IYMON3,  IZMON3 

.  READ { 101,1976 )IXMON3,IYMOK3,I2MON3 
WRITE (6,*)'  *=>  ISWEEP  & 

G.  IXMON3,IYMON3,IZMON3,  ISWEEP 

CLOSE ( 101 , STATUS* 'DELETE' ) 

LSG9-. FALSE. 

ENDIF 


OLD  VALVES*' 

NEW  VALVES*' 

OLD  VALVES*' 

NEW  VALVES*' 


OLD  VALVE*' 

NEW  VALVE*' 


INQUIRE ( FILE= ' RAXVMD ' , EXIST=LSG9 ) 

IP(LSG9)  THEN 

OPEN( 102, FILE* 'RAXVMD' ) 

WRITE (6,*)'  ==>  READING  MODIFICATION  FOR  RAX  VEL  ' 

READ( 102 , 1971 )RAXFTV 

WRITE (6,*)'  ==>  ISWEEP  E>  FACTOR* '  , 

&  RAXFTV , ISWEEP 

IRAXV=1 

CLOSE (102, STATUS  = ' DELETE ' ) 

LSG9=. FALSE. 

ENDJCF 

C 

INQUIRE ( FILE* 'RAXTMD ' , EXIST=LSG9 ) 

IP(LSG9)  THEN 

OPEN (102, FILE* ' RAXTMD ' ) 

WRITE (6,*)'  =*>  READING  MODIFICATION  FOR  RAX  TURB  ' 

READ ( 1 0 2 , 1 9 7 1 ) RAXFTT 

WRITE (6,*)'  =*>  ISWEEP  E.  FACTTOR* '  , 

S.  RAXFTT ,  ISWEEP 

IRAXT=1 

CLOSE (102, STATUS* ' DELETE ' ) 

LSG9*. FALSE. 

ENDIP 

INQUIRE ( FILE* ' RAXSMD ' , EXIST*LSG9 ) 

IF(LSG9)  THEN 

OPEN (102, FILE* 'RAXSMD' ) 

WRITE (6,*)'  =*>  READING  MODIFICATION  FOR  RAX  SCAL  ' 

READ (102, 1971 )RAXFTS 

WRITE  (6,*)'  =*>  ISWEEP  E.  FACTOR*', 

&  RAXFTS , ISWEEP 

IRAXS=1 

CLOSE (102, STATUS* ' DELETE ' ) 

LSG9*. FALSE. 

ENDIF 

C 

1971  FORMAT(F12.8) 

1972  FORMAT(2F12.8) 

1973  FORMAT( 3F12.8) 

1974  FORMAT (15) 

1975  FORMAT (412) 

1976  FORMAT (313) 

RETURN 
198  CONTINUE 

c  * - : - SECTION  8 - FINISH  OF  TIME  STEP. 

RETURN 

a  icic  ie  icir  ie  ir  fc  it  it  icit  icicicicit  ic  He  ★★★★★★★**************T(»r***^***********<r*** 

c 

; - GROUP  20.  Preliminary  print-out 

20  CONTINUE 
RETURN 

I************************************************-*:************** 

C  *  Make  changes  for  this  group  only  in  group  19. 

C -  GROUP  21.  Print-out  of  variables 

: - GROUP  22.  Spot-value  print-out 

_'******★******★***★**★********★★********★************»**★******* 

C 

: - GROUP  23.  Field  print-out  and  plot  control 


23  CONTINUE 
RETURN 

0**** ************************** ******im********* ******** ******** 

C 

C —  GROUP  24 .  Dumps  for  restarts 
C 

24  CONTINUE 
RETURN 
END 

0***************************** ***********.******** *********************** 
SUBROUTINE  TEMPER  t  HSTAT , TO , T , CPDR , RGAS , SC , NSC , NFO ) 
0********************************************** ************************* 
0  TEMPER  uses  an  iterative  procedure  to  calculate  temperature 
C  given  HI  and  a  guess  for  temperature 

0 - 

C 

DIMENSION  SC (NSC) 

DATA  NITER, DT0,TMIN/12, 50. ,12.345/ 

C 

CALL  ENTHAL(TO,HHH,CPDR,SC,NSC,NFO) 

C 

CP=CPDR*RGAS 

ENTH=CP*T0 

DT=(HSTAT-ENTH)/ (CP+1 .E-15 ) 

TEMPL=T0 

IF{NFO.GE.4)  WRITE(6,900)  TO  ,ENTH,HSTAT,,RGAS  ,  SC  ( 1 )  ,SC  (  2  )  ,  SC  (  3  ) 

TEMP  =T0+DT 
ITER=0 

100  ENTHL=ENTH 
ITER=ITER+1 

CALL  ENTHAL( TEMP, HHH, CPDR, SC, NSC, NFO) 

ENTH=CPDR*RGAS*TEMP 

RENTH= ( HSTAT-ENTHL ) / ( ( ENTH-ENTHL )  + 1 . E- 9 ) 

IF(NF0.GE.4)  WRITE( 6,910)  ITER , TEMP ,ENTH , ENTHL , HSTAT ,RENTH 
IF (ABS( ENTH-ENTHL) .LT. . 001*ABS(ENTH) )  RENTH=1. 

TEMPI *TEMPL+ ( TEMP-TEMPL ) *RENTH 
TEMP  1=AMAX1  (TEMPI,  .  5*TEMP  ,TMIN ). 

TEMP 1=AMIN1 (TEMPI , 1 . 5*TEMP , 5000  .  ) 

TEMPL=TEMP 

TEMP=TEMP1 

AR=ABS(RENTH) 

IF(  (AR.GT. 1.005  .OR.  AR.LT..995)  .AND.  ITER . LT . NITER )  GO  TO  100 
T*=TEMP 
RETURN 
C 

900  FORMAT('  TO  E  HS  RG  SC' , IP , 7E12 . 4 ) 

910  FORMAT ('  IT  T  E  EL  HS  RE ' , 1 3 , IP , 5E12 . 4 ) 

C 

END 

C 

0******************************************^*****»********************** 
SUBROUTINE  ENTHAL { TEMP , KSUM , CPSUM , SC . NS , NFC • 
0******************************************-***************************** 
C  ENTHAL  calculates  H/RT  from  JANNAF  data.  The  order  cf 
C  species  is  N  0  C  H. 

0 - 

C 

DIMENSION  SC( * ) , ZS { 7 , 2 , 4 ) 

DATA  ZS/  0 . 28532899E+01 ,  0 . 16  '  :212eE-02 ,  - ! . 629 3609 3E-06 , 

&  0.11441022E-09,  -0.78:574651-14,  -  3 . 8900809 3E+0 3 , 


Of  ->n  lo  o  r.  .  o  o  .  , .  o  i.  ..  n  r. 


G. 

G 

& 

& 

s. 

s< 

G 

G 

s. 

s> 

& 

s. 

Si 

& 

Si 

S 

Si 

Si 


0.63964897E+01, 
0.28670392E-05, 
-0.10640795E+04, 
0.36122139E+01, 
0. 33749008E-10, 
0 . 36703307E+01 , 
0.99492751E-05, 
-0.10638107E+04, 
0.44608041E+01, 
0.2274132SE-09, 
-0.98635982E+00, 
-0.66070878E-05, 
-0.48377527E+05, 
0.27167633E+01, 
0.10226682E-09, 
0.66305671E+01, 
0.41521180E-05, 
-0. 30279722E+05, 


0.37044177E+01, 
-0.12028885E-08, 
0.22336285E+01 , 
0.74853166E-03, 
-0.23907374E-14, 
0.37S37135E+01, 
-0.98189101E-08, 
0.36416345E+01, 
0.30981719E-02, 
-0.1S525954E-13, 
0.24007797E+01, 
0.20021861E-08, 
0.96951457E+01, 
0-29451374E-02, 
-0.48472145E-14, 
0.40701275E+01, 
-0.29637404E-08, 
-0 . 32270046E+00 


-0.14218753E-02 

-0.13954677E-13 

-0.19820647E-06 
-0.11978151E+04 
-0. 30233634E-02 
0 . 33031825E-11 

-0.12392571E-05 

-0.48961442E+05 

0.87350957E-02 

0.63274039E-15 

-0.80224374E-06 
-0.29905826E  05 
-0.11084499E-02 
0.80702103E-12 


K  =  1 

IF ( TEMP. LT. 1000.  )  K  =  2 

TEMP2=TEMP*TEMP 

HSUM=0. 

CPSUM=0. 

DO  100  IS=1,NS 
CP1=2S(1,K,IS) 

CP2=ZS(2,K,IS)*TEMP 

CP3=ZS( 3,K,IS)*TEMP2 

CP4=2S ( 4 , K , IS ) *TEMP2*TEMP 

CP5=ZS ( 5 , K , IS ) *TEMP2*TEMP2 

CPSUM=CPSUM+SC ( IS ) * ( CP1+CP2+CP3+CP4+CP5 ) 

100  HSUM  =HSUM+ 

1  SC(IS)*(CP1+.5*CP2+.33333*CP3+.25*CP4+.2*CP5+ZS(6,K,IS)/TEMP) 


RETURN 

END 


**:********************************:***********************************x» 

SUBROUTINE  XGETCV (N , M , C , V ) 

**X**X*************************x*************************ilr******x****x* 

XGETCV  used  to  set  up  procedure  to  get  a  patch  co  and  val . 


COMMON/IDATA/IDFILl ( 70 ) ,NUMREG, IDFIL2  (  49 ) 

COMMON/NPAT/NAMPAT (100) 

CHARACTER  N* ( ♦ ) , NAMPAT*  8 

IR=IRPAT(N) 

CALL  XCV( IR,M,C,V) 

RETURN 

END 

**X********X*******X***XXX**x*************X****xX************XX**X*XX-rx 

SUBROUTINE  XCV ( IR , MPHID , C , V ) 

•r*X*************************X*X******************X********x**Hr********* 

XCV  used  to  get  a  patch  co  and  val. 


COMMON  F ( 1  ) 


C  COMMON/ICOVL/M04,IOPHI 
C  LOGICAL  QLT 

C  INCLUDE  ' SATEAR ' 

C 

C  MPHI=MPHID 

C  10  =  0 

C  ‘  IF(EAETH)  I0=I0RTCV 

C  IF(0I<T(F(I0+10*IR-8)  ,23.0)  .AND.MPHI.LE.2)  MPHI*MPHI  +  8 

C  I0PHI=I0RCV(MPHI) 

C  IF(I0PHI.EQ.I0+NRTCV)  GO  TO  5 

C  I0PHI=I0PHI-4 

C  DO  2  I=1,NUMREG 

C  I0PHI=I0PHI+4 

C  I0L=I0RCVL(MPHI) 

C  IF (EARTH)  IOL=IOL+IORCVF(MPHI)-4 

C  IF(I0PHI.EQ.I0L+4)  GO  TO  5 

C  IF(IABS(IFIX(F(I0PHI+1) ) ) .NE.IR)  GO  TO  2 

C  C=F(I0PHI+2) 

C  V=F(I0PHI+3) 

C  GO  TO  7 

C  2  CONTINUE 
C  5  C=-999.0 

C  V=0.0 

C  7  CONTINUE 

r* 

U 

C  RETURN 

C  END 

C 

Q************************************************  *****************  *5»r**** 

C  SUBROUTINE  XSETCV(N,M,C,V,CF,VF) 

Q*********************************************************************** 

C  XGETCV  used  to  set  up  procedure  to  modify  a  patch  co  and  val. 

C - 

C 

C  COMMON/IDATA/IDFILl ( 70 ) ,NUMREG, IDFIL2 ( 49 ) 

C  COMMON/NPAT/NAMPAT(100) 

C  CHARACTER  N* ( * ) , NAMPAT*  8 

C 

C  IR=IRPAT(N) 

C  CALL  XSCV(IR,M,C,V,CF,VF) 

n 

c 

C  RETURN 

C  END 

C 

0*********************************************************************** 
C  SUBROUTINE  XSCV( IR,MPHID,C,V,CF,VF) 

0********************************************** **************** ********* 
C  XCV  used  to  get  a  patch  co  and  val. 

0 - 

r* 

w 

C  COMMON  F(l) 

C  COMMON/ICOVL/M04,IOPHI 

C  LOGICAL  QLT 

C  INCLUDE  ' SATEAR ' 

C 

C  MPHI*MPHID 

C  10=0 

C  IF (EARTH)  I0=I0RTCV 

C  IF(QLT(F(I0+10*IR-8)  ,23.0) .AND.MPHI,LE.2)  MPHI=MPHl  +  8 


1 0  PHI » I ORCV ( MPHI ) 

IF(IOPHI .EQ.IO+NRTCV)  GO  TO  5 
I0PHI=I0PHI-4 
DO  2  I=1,NUMREG 
IOPHI-IOPHI+4 
IOL=IORCVL(MPHI ) 

IF(EARTH)  I0L=I0L+I0RCVF(MPHI )-4 
IF(I0PHI.EQ.I0L+4)  GO  TO  5 
IF(IABS(IFIX(F(I0PHI+1) ) ) .NE.IR)  GO  TO  2 
C=F(I0PHI+2) 

V»F(I0PHI+3) 

WRITE(6,*)'  IN  SETCV  VAR  &  OLD  VALUES*  ',MPHI,C,V 
F ( IOPHI+2 ) =F ( IOPHI+2 ) *CF 
F(I0PHI+3)=F(I0PHI+3 )*VF 
C=F( IOPHI+2) 

V.F(I0PHI+3) 

WRITE(6,*)'  IN  SETCV  VAR  &  NEW  VALUES*  ',MPHI,C,V 
GO  TO  7 
2  CONTINUE 
5  C=-999.0 
V*0.0 

7  CONTINUE 

RETURN 

END 


SUBROUTINE  RUSHL ( XMDl , XMD2 , XMD3 , XMD4 , XMD5 , XMD8 , XEGl , XEG2 , XEG3 , 

&  XEG4,XEG5,XPR1,XEM,XEV,XSM) 

li****  *******  ic-kliicifkiniiciclfkiilclfkiiitleltifkiiitlelc-kiele****************************** 

RUSHL  prints  flow  rate  and  convergence  info 


101 

102 

103 

104 

105 
108 

109 

110 


WRITE ( 6 
WRITE ( 6 , 
WRITE(6, 
WRITE(6, 
WRITE ( 6 
WRITE ( 6 
WRITE ( 6 
WRITE ( 6 
WRITE ( 6 
WRITE ( 6 
WRITE ( 6 
WRITE ( 6 
WRITE (6 
WRITE ( 6 
WRITE (6 
WRITE (6 
WRITE ( 6 
WRITE (6 
WRITE (6 
FORMAT ( 
FORMAT ( 
FORMAT ( 
FORMAT { 
FORMAT ( 
FORMAT ( 
FORMAT ( 
FORMAT ( 


'  **************************************************' 
*)'  *******  FLOW  &  CONVERGENCE  DATA  *******' 

*)  ' 


************************************************** 


101 )  XMDl 

102) XMD2 

103) XMD3 

104) XMD4 

105) XMD5 

108) XMD8 

109)  XEGl 

110) XEG2 

111 ) XEG3 

112) XEG4 

113) XEG5 
116 )XPR1 

118 ) XEM 

119 ) XEV 

120) XSM 


MASS  FLOW  FRONT  BAFFLES  ',F12 
MASS  FLOW  BACK  BAFFLES  ',F12 
MASS  FLOW  CHIMNEY  BAFFLES  ',F12 
MASS  FLOW  INTO  ENGINE  ' , FI  2 
MASS  FLOW  OUT  OF  ENGINE  ',F12 
MASS  FLOW  OF  FUEL  ',F12 
ENERGY  FLOW  FRONT  BAFFLES  ',F12 
ENERGY  FLOW  BACK  BAFFLES  ',F12 


LB/S 
LB/S 
LB/S 
LB/S 
LB/S  ■ 
LB/S  ‘ 
BTU/S 
BTU/S 


1 


no  n  a  nn 


111  FORMAT ( ' 

112  FORMAT { ' 

113  FORMAT ( ' 
116  FORMAT ( ' 

118  FORMAT( ' 

119  FORMAT { ' 

120  FORMAT ( ' 
RETURN 
END 


ENERGY  FLOW  CHIMNEY  BAFFLES 
ENERGY  FLOW  INTO  ENGINE 
ENERGY  FLOW  OUT  OF  ENGINE 
ENGINE  PUMPING  RATIO 
NORMALIZED  MASS  ERROR 
NORMALIZED  MOMENTUM  ERROR 
SUM  OF  ALL  MASS 


',F12.4,'  BTU/S  ') 
',F12.4,'  BTU/S  ') 
' ,F12.4,  '  BTU/S  '  ) 
'  ,F12.4, ) 

' ,F12.4,  '  %  ' ) 

'  ,F12.4, '  %  ' ) 

',F12.4,'  LB/S  ') 


SUBROUTINE  AUTCHA(ISW) 
AUTUCH  writes  phida  file. 


DIMENSION  JDATE(6.) 


CALL  DUMP 

-pd - WARNING:  The  following  two  calls  may  be  machine  dependent — 

CALL  IDATE ( JDATE ( 1 ) ) 

CALL  ITIME ( JDATE ( 4 ) ) 

WRITE (6,*)'  ****  DUMP  CALLED  ****  ISWEEP=',ISW 
WRITE ( 6 , * ) '  DAY  MONTH  YEAR  +++  HOUR  MINUTE  SECOND ' 
WRITE( 6 ,1974) JDATE 
L974  F0RMAT(I4.I6,I8,8X,I6,I7.I8) 


RETURN 

END 


DISTRIBUTION  QUESTIONNAIRE 

The  Naval  Civil  Engineering  Laboratory  is  revising  its  primary  distribution  lists. 


SUBJECT  CATEGORIES 

1  SHORE  FAaiJTlES 

1A  Construction  methods  and  materials  (inciuding  corrosion 
control,  coatings) 

1B  Waterfront  structures  (maintenance/deterioration  control) 

1 C  Utilities  (including  power  conditioning) 

ID  Explosives  safety 
1 E  Aviation  Engineering  Test  Facilities 
1 F  Ftre  prevention  and  control 
tG  Arrtenna  technology 

1 H  Structural  analysis  and  design  (including  numerical  and 
computer  techniques) 

1J  Protective  construction  (including  hardened  shelters,  shock 
and  vibration  studies) 

1K  Soti/irodc  mechanics 
1L  Airfields  and  pavements 
1M  Physical  security 

2  ADVANCED  BASE  AND  AMPHIBIOUS  FAaiJTlES 

2A  Bass  facilities  Oncluding  shelters,  power  generation,  water 
supplies) 

2B  Expedient  roads/airfields/bridges 
2C  Over-the-beach  operations  (inciuding  breakwaters,  wave 
forces) 

20  POL  storage,  transfer,  and  distribution 
2E  Polar  engineering 

3  ENERGY/POWER  GENERATION 

3A  Thermal  conservation  (thermal  engineering  of  buildings, 
HVAC  systems,  energy  loss  measurement,  power 
generation) 

3B  Controls  and  electrical  conservation  (electrical  systems, 
energy  monitoring  and  control  systems) 

3C  Fuel  flexibility  (liquid  fuels,  ooal  utilization,  energy  from  solid 
waste) 


30  Alternate  energy  source  (geothermal  power,  photovoltaic 
power  systems,  solar  systems,  wind  systems,  energy 
storage  systems) 

3E  Site  data  and  systems  integration  (energy  resource  data. 

integrating  energy  systems) 

3F  ^CS  design 

4  ENVIRONMENTAL  PROTECTION 
4A  Solid  waste  management 

4B  Hazardous/toxie  materials  management 
4C  Waterwaste  management  and  sanitary  engineering 
40  on  pollution  removal  and  recovery 
4E  Airpollution 
4F  Noise  abatement 

5  OCEAN  ENGINEERING 

SA  Seafloor  sons  and  foundations 
SB  Seafloor  construction  systems  and  operations  (including 
diver  and  manipulator  tools) 

5C  Undersea  structures  and  materials 
50  Anchors  and  moorings 

SE  Undersea  power  systems,  electromechanical  cables,  ana 
connectors 

SF  Pressure  vessel  facilities 

5G  Physical  environment  (including  site  surveying) 

SH  Ocean-based  concrete  structures 

SJ  Hyperbaric  chambers 

SK  Undersea  cable  dynamics 

ARMYPEAP 

BOG  Shore  Facilities 

NRG  Energy 

04V  Environmsntal/Natural  Responses 

MGT  Management 

PRR  Pavements/RaUroads 


TYPES  OF  DOCUMENTS 

D  -  Techdata  Sheets;  R  -  Technical  Reports  and  Technical  Notes;  G  -  NOEL  Guides  and  Abstracts;  I  -  Index  to  TDS;  U  -  User 
Guides;  O  Nona  -  remove  my  name 


Old  Address: 


New  Address: 


Telephone  No.: 


Telephone  No.: 


INSTRUCTIONS 


The  Navai  Civil  Engineering  Laboratory  has  revised  its  primary  distribution  lists.  To  help  us  verify 
our  records  and  update  our  data  base,  please  do  the  following: 

•  Add -drde  number  on  list 

•  Remove  my  name  from  all  your  lists -check  box  on  list 

•  Change  my  address  -  fine  out  ino^rect  line  and  write  in  correction 
(DO  NOT  REMOVE  LABEL). 

•  Number  Of  copies  should  be  entered  after  the  title  of  the  subject  categories 
you  select 

•  Are  we  sending  you  the  correct  type  of  document?  tfnotcirciethetype(s)of 
document(s)  you  want  to  receive  fisted  on  the  back  of  this  card. 


Fold  on  lino,  stapio,  and  drop  in  mai. 


DEPARTMENT  OP  THE  NAVY 

Naval  Civil  Enginoering  Laboratory 

560  Laboratory  Oriva 

Port  Huanema  CA  93043-4328 


Official  Busineaa 

Penalty  for  Private  Uaa.  S300 


BUSINESS  REPLY  CARD 

FIRST  CLASS  PERMIT  NO.  12503  WASH  D.C. 


POSTAGE  WILL  BE  PAID  BY  ADDRESSEE 


NO  POSTAGE 
NECESSARY 
IPMAAEO 
m  THE 

UMTED  STATES 


COMMANDING  OFFICER 
CODE  L34 

560  LABORATORY  DRIVE 

NAVAL  CIVIL  ENGINEERING  LABORATORY 

PORT  HUENEME  CA  93043*4328 


NCEL  DOCUMENT  EVALUATION 

You  are  number  one  with  us;  how  do  we  rate  with  you? 

We  at  NCEL  want  to  provide  you  our  customer  the  best  possible  reports  but  we  need  your  help.  Therefore,  I  ask  you 
to  please  take  the  time  from  your  busy  schedule  to  fill  outthis  questionnaire.  Your  response  will  assist  us  in  providing 
the  best  reports  possible  for  our  users.  I  wish  to  thank  you  in  advance  for  your  assistance.  I  assure  you  that  the 
information  you  provide  will  help  us  to  be  more  responsive  to  your  future  needs. 

R.N.STORER,Ph.D.P.E. 

Technical  Director 

DOCUMENT  NO. _  TITLE  OF  DOCUMENT:  _ 


Date:  _ Respondent  Organization : 

Name: 

Phone: 

Category  {please  check): 

Sponsor _  User _  Proponent _  Other  {Specify) _ 

Please  answer  on  your  behalf  only;  not  on  your  organization's.  Please  check  {use  an  X)  only  the  block  that  most  closely 
describes  your  attitude  or  feeling  toward  that  statement: 

SA  Strongly  Agree  A  Agree  0  Neutral  D  Disagree  SD  Strongly  Disagree 


Activity  Code; 
Grade/Rank: 


SA  A  N  D  SD 

1.  The  technical  quality  of  the  report  ()  ( )  ( )  ()  ( ) 
is  comparable  to  most  of  my  other 

sources  of  technical  information. 

2.  The  report  will  make  signiflcant  ()()()()() 
improvements  in  the  cost  and  or 

perfoimance  of  my  operation. 

3.  The  report  acknowledges  related  ()()()()<) 
work  accomplished  by  others. 

4.  The  report  is  well  formatted.  ()()()()() 

5.  The  report  is  clearly  written.  ()()(){)() 


SA  A  N  D  SD 

6.  The  conclusions  and  recommenda-  ()()()()() 
tions  are  clear  and  directly  sup¬ 
ported  by  the  contents  of  the 

report 

7.  The  graphics,  tables,  and  photo-  ()()()()() 
graphs  are  well  done. 


Please  add  any  comments  (e.g..  in  what  ways  can  we 
improve  the  quality  of  our  reports?)  on  the  back  of  this 
form. 


DEPARTMENT  OP  THE  NAVY 

Naval  Civil  Engineering  Laboratory 
560  Laboratory  Drive 
PortHueneme  CA  03043-4028 


Official  Busirwes 

Penalty  lor  Private  Use,  S300 


BUSINESS  REPLY  CARD 

FIRST  cuss  PERMIT  NO.  12503  WASH  D.C. 


POSTAGE  WIU.  BE  PAID  BY  ADDRESSEE 


NO  POSTAGE 
NECESSARY 
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COMMANDING  OFFICER 
CODE  L03 

560  LABORATORY  DRIVE 

NAVAL  CIVIL  ENGINEERING  LABORATORY 

PORTHUENEME  CA  93043-4328 


